URL https://opencores.org/ocsvn/or1k/or1k/trunk
Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [generic/] [tclExecute.c] - Blame information for rev 1767

Go to most recent revision | Details | Compare with Previous | View Log

/*
 * tclExecute.c --
 *
 *      This file contains procedures that execute byte-compiled Tcl
 *      commands.
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclExecute.c,v 1.1.1.1 2002-01-16 10:25:27 markom 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;
 
/*
 * 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;
 
/*
 * 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 tcl_MathInProgress = 0;
 
/*
 * 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
 
/*
 * Array of instruction names.
 */
 
static char *opName[256];
 
/*
 * 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"
};
 
/*
 * 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 /* TCL_COMPILE_DEBUG */
 
/*
 * The following are statistics-related variables that record information
 * about the bytecode compiler and interpreter's operation. This includes
 * an array that records for each instruction how often it is executed.
 */
 
#ifdef TCL_COMPILE_STATS
static long numExecutions = 0;
static int instructionCount[256];
#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.
 */
 
#define STK_ITEM(offset)    (stackPtr[stackTop + (offset)])
#define STK_OBJECT(offset)  (STK_ITEM(offset).o)
#define STK_INT(offset)     (STK_ITEM(offset).i)
#define STK_POINTER(offset) (STK_ITEM(offset).p)
 
/*
 * 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].o = (objPtr))
 
#define POP_OBJECT() \
    (stackPtr[stackTop--].o)
 
/*
 * 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.
 *
 * NOTE THAT CLIENTS OF O2S ARE LIKELY TO FAIL IF THE OBJECT'S
 * STRING REP CONTAINS NULLS.
 */
 
#ifdef TCL_COMPILE_DEBUG
 
#define O2S(objPtr) \
    Tcl_GetStringFromObj((objPtr), &length)
 
#ifdef TCL_COMPILE_STATS
#define TRACE(a) \
    if (traceInstructions) { \
        fprintf(stdout, "%d: %d,%ld (%u) ", iPtr->numLevels, \
               stackTop, (tclObjsAlloced - tclObjsFreed), \
               (unsigned int)(pc - codePtr->codeStart)); \
        printf a; \
        fflush(stdout); \
    }
#define TRACE_WITH_OBJ(a, objPtr) \
    if (traceInstructions) { \
        fprintf(stdout, "%d: %d,%ld (%u) ", iPtr->numLevels, \
               stackTop, (tclObjsAlloced - tclObjsFreed), \
               (unsigned int)(pc - codePtr->codeStart)); \
        printf a; \
        bytes = Tcl_GetStringFromObj((objPtr), &length); \
        TclPrintSource(stdout, bytes, TclMin(length, 30)); \
        fprintf(stdout, "\n"); \
        fflush(stdout); \
    }
#else  /* not TCL_COMPILE_STATS */
#define TRACE(a) \
    if (traceInstructions) { \
        fprintf(stdout, "%d: %d (%u) ", iPtr->numLevels, stackTop, \
               (unsigned int)(pc - codePtr->codeStart)); \
        printf a; \
        fflush(stdout); \
    }
#define TRACE_WITH_OBJ(a, objPtr) \
    if (traceInstructions) { \
        fprintf(stdout, "%d: %d (%u) ", iPtr->numLevels, stackTop, \
               (unsigned int)(pc - codePtr->codeStart)); \
        printf a; \
        bytes = Tcl_GetStringFromObj((objPtr), &length); \
        TclPrintSource(stdout, bytes, TclMin(length, 30)); \
        fprintf(stdout, "\n"); \
        fflush(stdout); \
    }
#endif /* TCL_COMPILE_STATS */
 
#else  /* not TCL_COMPILE_DEBUG */
 
#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 /* TCL_COMPILE_STATS */
static void             FreeCmdNameInternalRep _ANSI_ARGS_((
                            Tcl_Obj *objPtr));
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 int opCode,
                            Tcl_Obj *opndPtr));
static void             InitByteCodeExecution _ANSI_ARGS_((
                            Tcl_Interp *interp));
static void             PrintByteCodeInfo _ANSI_ARGS_((ByteCode *codePtr));
static void             RecordTracebackInfo _ANSI_ARGS_((Tcl_Interp *interp,
                            unsigned char *pc, ByteCode *codePtr));
static int              SetCmdNameFromAny _ANSI_ARGS_((Tcl_Interp *interp,
                            Tcl_Obj *objPtr));
#ifdef TCL_COMPILE_DEBUG
static char *           StringForResultCode _ANSI_ARGS_((int result));
#endif /* TCL_COMPILE_DEBUG */
static void             UpdateStringOfCmdName _ANSI_ARGS_((Tcl_Obj *objPtr));
#ifdef TCL_COMPILE_DEBUG
static void             ValidatePcAndStackTop _ANSI_ARGS_((
                            ByteCode *codePtr, unsigned char *pc,
                            int stackTop, int stackLowerBound,
                            int stackUpperBound));
#endif /* TCL_COMPILE_DEBUG */
 
/*
 * 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 */
    UpdateStringOfCmdName,              /* 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. */
{
    int i;
 
    Tcl_RegisterObjType(&tclCmdNameType);
 
    (VOID *) memset(opName, 0, sizeof(opName));
    for (i = 0;  instructionTable[i].name != NULL;  i++) {
        opName[i] = instructionTable[i].name;
    }
 
#ifdef TCL_COMPILE_STATS    
    (VOID *) memset(instructionCount, 0, sizeof(instructionCount));
    (VOID *) memset(tclByteCodeCount, 0, sizeof(tclByteCodeCount));
    (VOID *) memset(tclSourceCount, 0, sizeof(tclSourceCount));
 
    Tcl_CreateCommand(interp, "evalstats", EvalStatsCmd,
                      (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
#endif /* TCL_COMPILE_STATS */
 
    if (Tcl_LinkVar(interp, "tcl_traceExec", (char *) &tclTraceExec,
                    TCL_LINK_INT) != TCL_OK) {
        panic("InitByteCodeExecution: can't create link for tcl_traceExec variable");
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * 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 = (StackItem *)
        ckalloc((unsigned) (TCL_STACK_INITIAL_SIZE * sizeof(StackItem)));
    eePtr->stackTop = -1;
    eePtr->stackEnd = (TCL_STACK_INITIAL_SIZE - 1);
 
    if (!execInitialized) {
        TclInitAuxDataTypeTable();
        InitByteCodeExecution(interp);
        execInitialized = 1;
    }
 
    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);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeExecEnv --
 *
 *      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
TclFinalizeExecEnv()
{
    execInitialized = 0;
    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(StackItem);
    int newBytes  = 2*currBytes;
    StackItem *newStackPtr = (StackItem *) 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 StackItem *stackPtr = eePtr->stackPtr;
                                /* Cached evaluation stack base pointer. */
    register int stackTop = eePtr->stackTop;
                                /* Cached top index of evaluation stack. */
    Tcl_Obj **objArrayPtr = codePtr->objArrayPtr;
                                /* Points to the ByteCode's object array. */
    unsigned char *pc = codePtr->codeStart;
                                /* The current program counter. */
    unsigned char opCode;       /* The current instruction code. */
    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, *namePtr, *objPtr;
    char *bytes;
    int length;
    long i;
    Tcl_DString command;        /* Used for debugging. If tclTraceExec >= 2
                                 * holds a string representing the last
                                 * command invoked. */
 
    /*
     * 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 5
    int (catchStackStorage[STATIC_CATCH_STACK_SIZE]);
    int *catchStackPtr = catchStackStorage;
    int catchTop = -1;
 
    /*
     * THIS PROC FAILS IF AN OBJECT'S STRING REP HAS A NULL BYTE.
     */
 
    if (tclTraceExec >= 2) {
        PrintByteCodeInfo(codePtr);
#ifdef TCL_COMPILE_STATS
        fprintf(stdout, "  Starting stack top=%d, system objects=%ld\n",
                eePtr->stackTop, (tclObjsAlloced - tclObjsFreed));
#else
        fprintf(stdout, "  Starting stack top=%d\n", eePtr->stackTop);
#endif /* TCL_COMPILE_STATS */
        fflush(stdout);
    }
 
#ifdef TCL_COMPILE_STATS
    numExecutions++;
#endif /* TCL_COMPILE_STATS */
 
    /*
     * 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->maxExcRangeDepth > STATIC_CATCH_STACK_SIZE) {
        catchStackPtr = (int *)
                ckalloc(codePtr->maxExcRangeDepth * sizeof(int));
    }
 
    /*
     * Make sure the stack has enough room to execute this ByteCode.
     */
 
    while ((stackTop + codePtr->maxStackDepth) > eePtr->stackEnd) {
        GrowEvaluationStack(eePtr);
        stackPtr = eePtr->stackPtr;
    }
 
    /*
     * Initialize the buffer that holds a string containing the name and
     * arguments for the last invoked command.
     */
 
    Tcl_DStringInit(&command);
 
    /*
     * 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) {
#ifdef TCL_COMPILE_STATS
            fprintf(stdout, "%d: %d,%ld ", iPtr->numLevels, stackTop,
                    (tclObjsAlloced - tclObjsFreed));
#else /* TCL_COMPILE_STATS */
            fprintf(stdout, "%d: %d ", iPtr->numLevels, stackTop);
#endif /* TCL_COMPILE_STATS */
            TclPrintInstruction(codePtr, pc);
            fflush(stdout);
        }
#endif /* TCL_COMPILE_DEBUG */
 
        opCode = *pc;
#ifdef TCL_COMPILE_STATS    
        instructionCount[opCode]++;
#endif /* TCL_COMPILE_STATS */
 
        switch (opCode) {
        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);
                fprintf(stderr, "  Source: ");
                TclPrintSource(stderr, codePtr->source, 150);
                panic("TclExecuteByteCode execution failure: end stack top != start stack top");
            }
            TRACE_WITH_OBJ(("done => return code=%d, result is ", result),
                    iPtr->objResultPtr);
            goto done;
 
        case INST_PUSH1:
            valuePtr = objArrayPtr[TclGetUInt1AtPtr(pc+1)];
            PUSH_OBJECT(valuePtr);
            TRACE_WITH_OBJ(("push1 %u => ", TclGetUInt1AtPtr(pc+1)),
                    valuePtr);
            ADJUST_PC(2);
 
        case INST_PUSH4:
            valuePtr = objArrayPtr[TclGetUInt4AtPtr(pc+1)];
            PUSH_OBJECT(valuePtr);
            TRACE_WITH_OBJ(("push4 %u => ", TclGetUInt4AtPtr(pc+1)),
                    valuePtr);
            ADJUST_PC(5);
 
        case INST_POP:
            valuePtr = POP_OBJECT();
            TRACE_WITH_OBJ(("pop => discarding "), valuePtr);
            TclDecrRefCount(valuePtr); /* finished with pop'ed object. */
            ADJUST_PC(1);
 
        case INST_DUP:
            valuePtr = stackPtr[stackTop].o;
            PUSH_OBJECT(Tcl_DuplicateObj(valuePtr));
            TRACE_WITH_OBJ(("dup => "), 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++) {
                    valuePtr = stackPtr[i].o;
                    bytes = TclGetStringFromObj(valuePtr, &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].o;
                        bytes = TclGetStringFromObj(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++) {
                        valuePtr = stackPtr[i].o;
                        Tcl_DecrRefCount(valuePtr);
                    }
                }
                stackTop -= opnd;
 
                PUSH_OBJECT(concatObjPtr);
                TRACE_WITH_OBJ(("concat %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:
            {
                char *cmdName;
                Command *cmdPtr;   /* Points to command's Command struct. */
                int objc = opnd;   /* The number of arguments. */
                Tcl_Obj **objv;    /* The array of argument objects. */
                Tcl_Obj *objv0Ptr; /* Holds objv[0], the command name. */
                int newPcOffset = 0;
                                   /* Instruction offset computed during
                                    * break, continue, error processing.
                                    * Init. to avoid compiler warning. */
                Tcl_Command cmd;
#ifdef TCL_COMPILE_DEBUG
                int isUnknownCmd = 0;
                char cmdNameBuf[30];
#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;
                }
 
                objv = &(stackPtr[stackTop - (objc-1)].o);
                objv0Ptr = objv[0];
                cmdName = TclGetStringFromObj(objv0Ptr, (int *) NULL);
 
                /*
                 * Find the procedure to execute this command. If there
                 * isn't one, then see if there is a command "unknown". If
                 * so, invoke it, passing it the original command words as
                 * arguments.
                 *
                 * We convert the objv[0] object to be a CmdName object.
                 * This caches a pointer to the Command structure for the
                 * command; this pointer is held in a ResolvedCmdName
                 * structure the object's internal rep. points to.
                 */
 
                cmd = Tcl_GetCommandFromObj(interp, objv0Ptr);
                cmdPtr = (Command *) cmd;
 
                /*
                 * If the command is still not found, handle it with the
                 * "unknown" proc.
                 */
 
                if (cmdPtr == NULL) {
                    cmd = Tcl_FindCommand(interp, "unknown",
                            (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
                    if (cmd == (Tcl_Command) NULL) {
                        Tcl_ResetResult(interp);
                        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                                "invalid command name \"", cmdName, "\"",
                                (char *) NULL);
                        TRACE(("%s %u => unknown proc not found: ",
                               opName[opCode], objc));
                        result = TCL_ERROR;
                        goto checkForCatch;
                    }
                    cmdPtr = (Command *) cmd;
#ifdef TCL_COMPILE_DEBUG
                    isUnknownCmd = 1;
#endif /*TCL_COMPILE_DEBUG*/                    
                    stackTop++; /* need room for new inserted objv[0] */
                    for (i = objc;  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) {
                    char buffer[50];
 
                    sprintf(buffer, "%d: (%u) invoking ", iPtr->numLevels,
                            (unsigned int)(pc - codePtr->codeStart));
                    Tcl_DStringAppend(&command, buffer, -1);
 
#ifdef TCL_COMPILE_DEBUG
                    if (traceInstructions) { /* tclTraceExec == 3 */
                        strncpy(cmdNameBuf, cmdName, 20);
                        TRACE(("%s %u => call ", opName[opCode],
                               (isUnknownCmd? objc-1 : objc)));
                    } else {
                        fprintf(stdout, "%s", buffer);
                    }
#else /* TCL_COMPILE_DEBUG */
                    fprintf(stdout, "%s", buffer);
#endif /*TCL_COMPILE_DEBUG*/
 
                    for (i = 0;  i < objc;  i++) {
                        bytes = TclGetStringFromObj(objv[i], &length);
                        TclPrintSource(stdout, bytes, TclMin(length, 15));
                        fprintf(stdout, " ");
 
                        sprintf(buffer, "\"%.*s\" ", TclMin(length, 15), bytes);
                        Tcl_DStringAppend(&command, buffer, -1);
                    }
                    fprintf(stdout, "\n");
                    fflush(stdout);
 
                    Tcl_DStringFree(&command);
                }
 
                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.
                 */
 
                i = (stackTop - (objc-1));
                while (i <= stackTop) {
                    valuePtr = stackPtr[i].o;
                    TclDecrRefCount(valuePtr);
                    i++;
                }
                stackTop -= objc;
 
                /*
                 * 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(("%s %u => ...after \"%.20s\", result=",
                            opName[opCode], 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 = TclGetExceptionRangeForPc(pc,
                            /*catchOnly*/ 0, codePtr);
                    if (rangePtr == NULL) {
                        TRACE(("%s %u => ... after \"%.20s\", no encl. loop or catch, returning %s\n",
                                opName[opCode], objc, cmdNameBuf,
                                StringForResultCode(result)));
                        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(("%s %u => ... after \"%.20s\", %s, loop w/o continue, checking for catch\n",
                                   opName[opCode], objc, cmdNameBuf,
                                   StringForResultCode(result)));
                            goto checkForCatch;
                        } else {
                            newPcOffset = rangePtr->continueOffset;
                        }
                        TRACE(("%s %u => ... after \"%.20s\", %s, range at %d, new pc %d\n",
                               opName[opCode], objc, cmdNameBuf,
                               StringForResultCode(result),
                               rangePtr->codeOffset, newPcOffset));
                        break;
                    case CATCH_EXCEPTION_RANGE:
                        TRACE(("%s %u => ... after \"%.20s\", %s...\n",
                               opName[opCode], objc, cmdNameBuf,
                               StringForResultCode(result)));
                        goto processCatch; /* it will use rangePtr */
                    default:
                        panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
                    }
                    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(("%s %u => ... after \"%.20s\", TCL_ERROR ",
                            opName[opCode], 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(("%s %u => ... after \"%.20s\", TCL_RETURN\n",
                            opName[opCode], objc, cmdNameBuf));
                    goto checkForCatch;
 
                default:
                    TRACE_WITH_OBJ(("%s %u => ... after \"%.20s\", OTHER RETURN CODE %d ",
                            opName[opCode], objc, cmdNameBuf, result),
                            Tcl_GetObjResult(interp));
                    goto checkForCatch;
                } /* end of switch on result from invoke instruction */
            }
 
        case INST_EVAL_STK:
            objPtr = POP_OBJECT();
            DECACHE_STACK_INFO();
            result = Tcl_EvalObj(interp, objPtr);
            CACHE_STACK_INFO();
            if (result == TCL_OK) {
                /*
                 * Normal return; push the eval's object result.
                 */
 
                PUSH_OBJECT(Tcl_GetObjResult(interp));
                TRACE_WITH_OBJ(("evalStk \"%.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 = TclGetExceptionRangeForPc(pc, /*catchOnly*/ 0,
                        codePtr);
                if (rangePtr == NULL) {
                    TRACE(("evalStk \"%.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(("evalStk \"%.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(("evalStk \"%.30s\" => %s, range at %d, new pc %d ",
                            O2S(objPtr), StringForResultCode(result),
                            rangePtr->codeOffset, newPcOffset), valuePtr);
                    break;
                case CATCH_EXCEPTION_RANGE:
                    TRACE_WITH_OBJ(("evalStk \"%.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(("evalStk \"%.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(("exprStk \"%.30s\" => ERROR: ",
                        O2S(objPtr)), Tcl_GetObjResult(interp));
                Tcl_DecrRefCount(objPtr);
                goto checkForCatch;
            }
            stackPtr[++stackTop].o = valuePtr; /* already has right refct */
            TRACE_WITH_OBJ(("exprStk \"%.30s\" => ", O2S(objPtr)), valuePtr);
            TclDecrRefCount(objPtr);
            ADJUST_PC(1);
 
        case INST_LOAD_SCALAR4:
            opnd = TclGetInt4AtPtr(pc+1);
            pcAdjustment = 5;
            goto doLoadScalar;
 
        case INST_LOAD_SCALAR1:
            opnd = TclGetUInt1AtPtr(pc+1);
            pcAdjustment = 2;
 
            doLoadScalar:
            DECACHE_STACK_INFO();
            valuePtr = TclGetIndexedScalar(interp, opnd,
                                           /*leaveErrorMsg*/ 1);
            CACHE_STACK_INFO();
            if (valuePtr == NULL) {
                TRACE_WITH_OBJ(("%s %u => ERROR: ", opName[opCode], opnd),
                        Tcl_GetObjResult(interp));
                result = TCL_ERROR;
                goto checkForCatch;
            }
            PUSH_OBJECT(valuePtr);
            TRACE_WITH_OBJ(("%s %u => ", opName[opCode], opnd), valuePtr);
            ADJUST_PC(pcAdjustment);
 
        case INST_LOAD_SCALAR_STK:
            namePtr = POP_OBJECT();
            DECACHE_STACK_INFO();
            valuePtr = Tcl_ObjGetVar2(interp, namePtr, (Tcl_Obj *) NULL,
                                      TCL_LEAVE_ERR_MSG);
            CACHE_STACK_INFO();
            if (valuePtr == NULL) {
                TRACE_WITH_OBJ(("loadScalarStk \"%.30s\" => ERROR: ",
                        O2S(namePtr)), Tcl_GetObjResult(interp));
                Tcl_DecrRefCount(namePtr);
                result = TCL_ERROR;
                goto checkForCatch;
            }
            PUSH_OBJECT(valuePtr);
            TRACE_WITH_OBJ(("loadScalarStk \"%.30s\" => ",
                    O2S(namePtr)), valuePtr);
            TclDecrRefCount(namePtr);
            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(("%s %u \"%.30s\" => ERROR: ",
                            opName[opCode], opnd, O2S(elemPtr)),
                            Tcl_GetObjResult(interp));
                    Tcl_DecrRefCount(elemPtr);
                    result = TCL_ERROR;
                    goto checkForCatch;
                }
                PUSH_OBJECT(valuePtr);
                TRACE_WITH_OBJ(("%s %u \"%.30s\" => ",
                        opName[opCode], opnd, O2S(elemPtr)), valuePtr);
                TclDecrRefCount(elemPtr);
            }
            ADJUST_PC(pcAdjustment);
 
        case INST_LOAD_ARRAY_STK:
            {
                Tcl_Obj *elemPtr = POP_OBJECT();
 
                namePtr = POP_OBJECT();
                DECACHE_STACK_INFO();
                valuePtr = Tcl_ObjGetVar2(interp, namePtr, elemPtr,
                        TCL_LEAVE_ERR_MSG);
                CACHE_STACK_INFO();
                if (valuePtr == NULL) {
                    TRACE_WITH_OBJ(("loadArrayStk \"%.30s(%.30s)\" => ERROR: ",
                            O2S(namePtr), O2S(elemPtr)),
                            Tcl_GetObjResult(interp));
                    Tcl_DecrRefCount(namePtr);
                    Tcl_DecrRefCount(elemPtr);
                    result = TCL_ERROR;
                    goto checkForCatch;
                }
                PUSH_OBJECT(valuePtr);
                TRACE_WITH_OBJ(("loadArrayStk \"%.30s(%.30s)\" => ",
                        O2S(namePtr), O2S(elemPtr)), valuePtr);
                TclDecrRefCount(namePtr);
                TclDecrRefCount(elemPtr);
            }
            ADJUST_PC(1);
 
        case INST_LOAD_STK:
            namePtr = POP_OBJECT();
            DECACHE_STACK_INFO();
            valuePtr = Tcl_ObjGetVar2(interp, namePtr, NULL,
                    TCL_PARSE_PART1|TCL_LEAVE_ERR_MSG);
            CACHE_STACK_INFO();
            if (valuePtr == NULL) {
                TRACE_WITH_OBJ(("loadStk \"%.30s\" => ERROR: ",
                        O2S(namePtr)), Tcl_GetObjResult(interp));
                Tcl_DecrRefCount(namePtr);
                result = TCL_ERROR;
                goto checkForCatch;
            }
            PUSH_OBJECT(valuePtr);
            TRACE_WITH_OBJ(("loadStk \"%.30s\" => ", O2S(namePtr)),
                    valuePtr);
            TclDecrRefCount(namePtr);
            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(("%s %u <- \"%.30s\" => ERROR: ",
                        opName[opCode], opnd, O2S(valuePtr)),
                        Tcl_GetObjResult(interp));
                Tcl_DecrRefCount(valuePtr);
                result = TCL_ERROR;
                goto checkForCatch;
            }
            PUSH_OBJECT(value2Ptr);
            TRACE_WITH_OBJ(("%s %u <- \"%.30s\" => ",
                    opName[opCode], opnd, O2S(valuePtr)), value2Ptr);
            TclDecrRefCount(valuePtr);
            ADJUST_PC(pcAdjustment);
 
        case INST_STORE_SCALAR_STK:
            valuePtr = POP_OBJECT();
            namePtr = POP_OBJECT();
            DECACHE_STACK_INFO();
            value2Ptr = Tcl_ObjSetVar2(interp, namePtr, NULL, valuePtr,
                    TCL_LEAVE_ERR_MSG);
            CACHE_STACK_INFO();
            if (value2Ptr == NULL) {
                TRACE_WITH_OBJ(
                        ("storeScalarStk \"%.30s\" <- \"%.30s\" => ERROR: ",
                        O2S(namePtr), O2S(valuePtr)),
                        Tcl_GetObjResult(interp));
                Tcl_DecrRefCount(namePtr);
                Tcl_DecrRefCount(valuePtr);
                result = TCL_ERROR;
                goto checkForCatch;
            }
            PUSH_OBJECT(value2Ptr);
            TRACE_WITH_OBJ(
                    ("storeScalarStk \"%.30s\" <- \"%.30s\" => ",
                    O2S(namePtr),
                    O2S(valuePtr)),
                    value2Ptr);
            TclDecrRefCount(namePtr);
            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(
                            ("%s %u \"%.30s\" <- \"%.30s\" => ERROR: ",
                            opName[opCode], 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(("%s %u \"%.30s\" <- \"%.30s\" => ",
                        opName[opCode], 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();
                namePtr = POP_OBJECT();
                DECACHE_STACK_INFO();
                value2Ptr = Tcl_ObjSetVar2(interp, namePtr, elemPtr,
                        valuePtr, TCL_LEAVE_ERR_MSG);
                CACHE_STACK_INFO();
                if (value2Ptr == NULL) {
                    TRACE_WITH_OBJ(("storeArrayStk \"%.30s(%.30s)\" <- \"%.30s\" => ERROR: ",
                            O2S(namePtr), O2S(elemPtr), O2S(valuePtr)),
                            Tcl_GetObjResult(interp));
                    Tcl_DecrRefCount(namePtr);
                    Tcl_DecrRefCount(elemPtr);
                    Tcl_DecrRefCount(valuePtr);
                    result = TCL_ERROR;
                    goto checkForCatch;
                }
                PUSH_OBJECT(value2Ptr);
                TRACE_WITH_OBJ(("storeArrayStk \"%.30s(%.30s)\" <- \"%.30s\" => ",
                        O2S(namePtr), O2S(elemPtr), O2S(valuePtr)),
                        value2Ptr);
                TclDecrRefCount(namePtr);
                TclDecrRefCount(elemPtr);
                TclDecrRefCount(valuePtr);
            }
            ADJUST_PC(1);
 
        case INST_STORE_STK:
            valuePtr = POP_OBJECT();
            namePtr = POP_OBJECT();
            DECACHE_STACK_INFO();
            value2Ptr = Tcl_ObjSetVar2(interp, namePtr, NULL, valuePtr,
                    TCL_PARSE_PART1|TCL_LEAVE_ERR_MSG);
            CACHE_STACK_INFO();
            if (value2Ptr == NULL) {
                TRACE_WITH_OBJ(("storeStk \"%.30s\" <- \"%.30s\" => ERROR: ",
                        O2S(namePtr), O2S(valuePtr)),
                        Tcl_GetObjResult(interp));
                Tcl_DecrRefCount(namePtr);
                Tcl_DecrRefCount(valuePtr);
                result = TCL_ERROR;
                goto checkForCatch;
            }
            PUSH_OBJECT(value2Ptr);
            TRACE_WITH_OBJ(("storeStk \"%.30s\" <- \"%.30s\" => ",
                    O2S(namePtr), O2S(valuePtr)), value2Ptr);
            TclDecrRefCount(namePtr);
            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(("incrScalar1 %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(("incrScalar1 %u (by %ld) => ERROR: ",
                        opnd, i), Tcl_GetObjResult(interp));
                Tcl_DecrRefCount(valuePtr);
                result = TCL_ERROR;
                goto checkForCatch;
            }
            PUSH_OBJECT(value2Ptr);
            TRACE_WITH_OBJ(("incrScalar1 %u (by %ld) => ", opnd, i),
                    value2Ptr);
            TclDecrRefCount(valuePtr);
            ADJUST_PC(2);
 
        case INST_INCR_SCALAR_STK:
        case INST_INCR_STK:
            valuePtr = POP_OBJECT();
            namePtr = POP_OBJECT();
            if (valuePtr->typePtr != &tclIntType) {
                result = tclIntType.setFromAnyProc(interp, valuePtr);
                if (result != TCL_OK) {
                    TRACE_WITH_OBJ(("%s \"%.30s\" (by %s) => ERROR converting increment amount to int: ",
                            opName[opCode], O2S(namePtr), O2S(valuePtr)),
                            Tcl_GetObjResult(interp));
                    Tcl_DecrRefCount(namePtr);
                    Tcl_DecrRefCount(valuePtr);
                    goto checkForCatch;
                }
            }
            i = valuePtr->internalRep.longValue;
            DECACHE_STACK_INFO();
            value2Ptr = TclIncrVar2(interp, namePtr, (Tcl_Obj *) NULL, i,
                /*part1NotParsed*/ (opCode == INST_INCR_STK));
            CACHE_STACK_INFO();
            if (value2Ptr == NULL) {
                TRACE_WITH_OBJ(("%s \"%.30s\" (by %ld) => ERROR: ",
                        opName[opCode], O2S(namePtr), i),
                        Tcl_GetObjResult(interp));
                Tcl_DecrRefCount(namePtr);
                Tcl_DecrRefCount(valuePtr);
                result = TCL_ERROR;
                goto checkForCatch;
            }
            PUSH_OBJECT(value2Ptr);
            TRACE_WITH_OBJ(("%s \"%.30s\" (by %ld) => ",
                    opName[opCode], O2S(namePtr), i), value2Ptr);
            Tcl_DecrRefCount(namePtr);
            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(("incrArray1 %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(("incrArray1 %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(("incrArray1 %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();
                namePtr = POP_OBJECT();
                if (valuePtr->typePtr != &tclIntType) {
                    result = tclIntType.setFromAnyProc(interp, valuePtr);
                    if (result != TCL_OK) {
                        TRACE_WITH_OBJ(("incrArrayStk \"%.30s(%.30s)\" (by %s) => ERROR converting increment amount to int: ",
                                O2S(namePtr), O2S(elemPtr), O2S(valuePtr)),
                                Tcl_GetObjResult(interp));
                        Tcl_DecrRefCount(namePtr);
                        Tcl_DecrRefCount(elemPtr);
                        Tcl_DecrRefCount(valuePtr);
                        goto checkForCatch;
                    }
                }
                i = valuePtr->internalRep.longValue;
                DECACHE_STACK_INFO();
                value2Ptr = TclIncrVar2(interp, namePtr, elemPtr, i,
                                        /*part1NotParsed*/ 0);
                CACHE_STACK_INFO();
                if (value2Ptr == NULL) {
                    TRACE_WITH_OBJ(("incrArrayStk \"%.30s(%.30s)\" (by %ld) => ERROR: ",
                            O2S(namePtr), O2S(elemPtr), i),
                            Tcl_GetObjResult(interp));
                    Tcl_DecrRefCount(namePtr);
                    Tcl_DecrRefCount(elemPtr);
                    Tcl_DecrRefCount(valuePtr);
                    result = TCL_ERROR;
                    goto checkForCatch;
                }
                PUSH_OBJECT(value2Ptr);
                TRACE_WITH_OBJ(("incrArrayStk \"%.30s(%.30s)\" (by %ld) => ",
                        O2S(namePtr), O2S(elemPtr), i), value2Ptr);
                Tcl_DecrRefCount(namePtr);
                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(("incrScalar1Imm %u %ld => ERROR: ",
                        opnd, i), Tcl_GetObjResult(interp));
                result = TCL_ERROR;
                goto checkForCatch;
            }
            PUSH_OBJECT(value2Ptr);
            TRACE_WITH_OBJ(("incrScalar1Imm %u %ld => ", opnd, i),
                    value2Ptr);
            ADJUST_PC(3);
 
        case INST_INCR_SCALAR_STK_IMM:
        case INST_INCR_STK_IMM:
            namePtr = POP_OBJECT();
            i = TclGetInt1AtPtr(pc+1);
            DECACHE_STACK_INFO();
            value2Ptr = TclIncrVar2(interp, namePtr, (Tcl_Obj *) NULL, i,
                    /*part1NotParsed*/ (opCode == INST_INCR_STK_IMM));
            CACHE_STACK_INFO();
            if (value2Ptr == NULL) {
                TRACE_WITH_OBJ(("%s \"%.30s\" %ld => ERROR: ",
                        opName[opCode], O2S(namePtr), i),
                        Tcl_GetObjResult(interp));
                result = TCL_ERROR;
                Tcl_DecrRefCount(namePtr);
                goto checkForCatch;
            }
            PUSH_OBJECT(value2Ptr);
            TRACE_WITH_OBJ(("%s \"%.30s\" %ld => ",
                    opName[opCode], O2S(namePtr), i), value2Ptr);
            TclDecrRefCount(namePtr);
            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(("incrArray1Imm %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(("incrArray1Imm %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();
                namePtr = POP_OBJECT();
                DECACHE_STACK_INFO();
                value2Ptr = TclIncrVar2(interp, namePtr, elemPtr, i,
                        /*part1NotParsed*/ 0);
                CACHE_STACK_INFO();
                if (value2Ptr == NULL) {
                    TRACE_WITH_OBJ(("incrArrayStkImm \"%.30s(%.30s)\" (by %ld) => ERROR: ",
                            O2S(namePtr), O2S(elemPtr), i),
                            Tcl_GetObjResult(interp));
                    Tcl_DecrRefCount(namePtr);
                    Tcl_DecrRefCount(elemPtr);
                    result = TCL_ERROR;
                    goto checkForCatch;
                }
                PUSH_OBJECT(value2Ptr);
                TRACE_WITH_OBJ(("incrArrayStkImm \"%.30s(%.30s)\" (by %ld) => ",
                        O2S(namePtr), O2S(elemPtr), i), value2Ptr);
                Tcl_DecrRefCount(namePtr);
                Tcl_DecrRefCount(elemPtr);
            }
            ADJUST_PC(2);
 
        case INST_JUMP1:
            opnd = TclGetInt1AtPtr(pc+1);
            TRACE(("jump1 %d => new pc %u\n", opnd,
                   (unsigned int)(pc + opnd - codePtr->codeStart)));
            ADJUST_PC(opnd);
 
        case INST_JUMP4:
            opnd = TclGetInt4AtPtr(pc+1);
            TRACE(("jump4 %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(("%s %d => ERROR: ", opName[opCode],
                                opnd), Tcl_GetObjResult(interp));
                        Tcl_DecrRefCount(valuePtr);
                        goto checkForCatch;
                    }
                }
                if (b) {
                    TRACE(("%s %d => %.20s true, new pc %u\n",
                            opName[opCode], opnd, O2S(valuePtr),
                            (unsigned int)(pc+opnd - codePtr->codeStart)));
                    TclDecrRefCount(valuePtr);
                    ADJUST_PC(opnd);
                } else {
                    TRACE(("%s %d => %.20s false\n", opName[opCode], 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(("%s %d => ERROR: ", opName[opCode],
                                opnd), Tcl_GetObjResult(interp));
                        Tcl_DecrRefCount(valuePtr);
                        goto checkForCatch;
                    }
                }
                if (b) {
                    TRACE(("%s %d => %.20s true\n", opName[opCode], opnd,
                            O2S(valuePtr)));
                    TclDecrRefCount(valuePtr);
                    ADJUST_PC(pcAdjustment);
                } else {
                    TRACE(("%s %d => %.20s false, new pc %u\n",
                            opName[opCode], 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 {        /* FAILS IF NULL STRING REP */
                    s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
                    if (TclLooksLikeInt(s)) {
                        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(("%s \"%.20s\" => ILLEGAL TYPE %s \n",
                                opName[opCode], O2S(valuePtr),
                                (t1Ptr? t1Ptr->name : "null")));
                        IllegalExprOperandType(interp, opCode, 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 {        /* FAILS IF NULL STRING REP */
                    s = Tcl_GetStringFromObj(value2Ptr, (int *) NULL);
                    if (TclLooksLikeInt(s)) {
                        result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
                                value2Ptr, &i);
                        i2 = (i != 0);
                    } else {
                        result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL,
                                value2Ptr, &i2);
                        i2 = (i2 != 0);
                    }
                    if (result != TCL_OK) {
                        TRACE(("%s \"%.20s\" => ILLEGAL TYPE %s \n",
                                opName[opCode], O2S(value2Ptr),
                                (t2Ptr? t2Ptr->name : "null")));
                        IllegalExprOperandType(interp, opCode, value2Ptr);
                        Tcl_DecrRefCount(valuePtr);
                        Tcl_DecrRefCount(value2Ptr);
                        goto checkForCatch;
                    }
                }
 
                /*
                 * Reuse the valuePtr object already on stack if possible.
                 */
 
                if (opCode == INST_LOR) {
                    iResult = (i1 || i2);
                } else {
                    iResult = (i1 && i2);
                }
                if (Tcl_IsShared(valuePtr)) {
                    PUSH_OBJECT(Tcl_NewLongObj(iResult));
                    TRACE(("%s %.20s %.20s => %d\n", opName[opCode],
                           O2S(valuePtr), O2S(value2Ptr), iResult));
                    TclDecrRefCount(valuePtr);
                } else {        /* reuse the valuePtr object */
                    TRACE(("%s %.20s %.20s => %d\n",
                           opName[opCode], /* NB: stack top is off by 1 */
                           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_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;
 
                if ((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType)) {
                    s1 = Tcl_GetStringFromObj(valuePtr, &length);
                    if (TclLooksLikeInt(s1)) { /* FAILS IF NULLS */
                        (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)) { /* FAILS IF NULLS */
                        (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.
                     * THIS FAILS IF AN OBJECT'S STRING REP CONTAINS NULLS.
                     */
                    int cmpValue;
                    s1 = TclGetStringFromObj(valuePtr, &length);
                    s2 = TclGetStringFromObj(value2Ptr, &length);
                    cmpValue = strcmp(s1, s2);
                    switch (opCode) {
                    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 (opCode) {
                    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 (opCode) {
                    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(("%s %.20s %.20s => %ld\n", opName[opCode],
                        O2S(valuePtr), O2S(value2Ptr), iResult));
                    TclDecrRefCount(valuePtr);
                } else {        /* reuse the valuePtr object */
                    TRACE(("%s %.20s %.20s => %ld\n",
                        opName[opCode], /* NB: stack top is off by 1 */
                        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(("%s %.20s %.20s => ILLEGAL 1st TYPE %s\n",
                              opName[opCode], O2S(valuePtr), O2S(value2Ptr),
                              (valuePtr->typePtr?
                                   valuePtr->typePtr->name : "null")));
                        IllegalExprOperandType(interp, opCode, 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(("%s %.20s %.20s => ILLEGAL 2nd TYPE %s\n",
                              opName[opCode], O2S(valuePtr), O2S(value2Ptr),
                              (value2Ptr->typePtr?
                                   value2Ptr->typePtr->name : "null")));
                        IllegalExprOperandType(interp, opCode, value2Ptr);
                        Tcl_DecrRefCount(valuePtr);
                        Tcl_DecrRefCount(value2Ptr);
                        goto checkForCatch;
                    }
                }
 
                switch (opCode) {
                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(("mod %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(("%s %ld %ld => %ld\n", opName[opCode], i, i2,
                           iResult));
                    TclDecrRefCount(valuePtr);
                } else {        /* reuse the valuePtr object */
                    TRACE(("%s %ld %ld => %ld\n", opName[opCode], i, i2,
                        iResult)); /* NB: stack top is off by 1 */
                    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) {
                    d1 = valuePtr->internalRep.doubleValue;
                } else {             /* try to convert; FAILS IF NULLS */
                    char *s = Tcl_GetStringFromObj(valuePtr, &length);
                    if (TclLooksLikeInt(s)) {
                        result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
                                valuePtr, &i);
                    } else {
                        result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
                                valuePtr, &d1);
                    }
                    if (result != TCL_OK) {
                        TRACE(("%s %.20s %.20s => ILLEGAL 1st TYPE %s\n",
                               opName[opCode], s, O2S(value2Ptr),
                               (valuePtr->typePtr?
                                    valuePtr->typePtr->name : "null")));
                        IllegalExprOperandType(interp, opCode, valuePtr);
                        Tcl_DecrRefCount(valuePtr);
                        Tcl_DecrRefCount(value2Ptr);
                        goto checkForCatch;
                    }
                    t1Ptr = valuePtr->typePtr;
                }
 
                if (t2Ptr == &tclIntType) {
                    i2 = value2Ptr->internalRep.longValue;
                } else if (t2Ptr == &tclDoubleType) {
                    d2 = value2Ptr->internalRep.doubleValue;
                } else {             /* try to convert; FAILS IF NULLS */
                    char *s = Tcl_GetStringFromObj(value2Ptr, &length);
                    if (TclLooksLikeInt(s)) {
                        result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
                                value2Ptr, &i2);
                    } else {
                        result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
                                value2Ptr, &d2);
                    }
                    if (result != TCL_OK) {
                        TRACE(("%s %.20s %.20s => ILLEGAL 2nd TYPE %s\n",
                               opName[opCode], O2S(valuePtr), s,
                               (value2Ptr->typePtr?
                                    value2Ptr->typePtr->name : "null")));
                        IllegalExprOperandType(interp, opCode, 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 (opCode) {
                    case INST_ADD:
                        dResult = d1 + d2;
                        break;
                    case INST_SUB:
                        dResult = d1 - d2;
                        break;
                    case INST_MULT:
                        dResult = d1 * d2;
                        break;
                    case INST_DIV:
                        if (d2 == 0.0) {
                            TRACE(("div %.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(("%s %.20s %.20s => IEEE FLOATING PT ERROR\n",
                               opName[opCode], O2S(valuePtr), O2S(value2Ptr)));
                        TclExprFloatError(interp, dResult);
                        result = TCL_ERROR;
                        Tcl_DecrRefCount(valuePtr);
                        Tcl_DecrRefCount(value2Ptr);
                        goto checkForCatch;
                    }
                } else {
                    /*
                     * Do integer arithmetic.
                     */
                    switch (opCode) {
                    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(("div %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(("%s %.6g %.6g => %.6g\n", opName[opCode],
                               d1, d2, dResult));
                    } else {
                        PUSH_OBJECT(Tcl_NewLongObj(iResult));
                        TRACE(("%s %ld %ld => %ld\n", opName[opCode],
                               i, i2, iResult));
                    }
                    TclDecrRefCount(valuePtr);
                } else {            /* reuse the valuePtr object */
                    if (doDouble) { /* NB: stack top is off by 1 */
                        TRACE(("%s %.6g %.6g => %.6g\n", opName[opCode],
                               d1, d2, dResult));
                        Tcl_SetDoubleObj(valuePtr, dResult);
                    } else {
                        TRACE(("%s %ld %ld => %ld\n", opName[opCode],
                               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].o;
                tPtr = valuePtr->typePtr;
                if ((tPtr != &tclIntType) && (tPtr != &tclDoubleType)) {
                    char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
                    if (TclLooksLikeInt(s)) { /* FAILS IF NULLS */
                        result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
                                valuePtr, &i);
                    } else {
                        result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
                                valuePtr, &d);
                    }
                    if (result != TCL_OK) {
                        TRACE(("%s \"%.20s\" => ILLEGAL TYPE %s \n",
                                opName[opCode], s,
                                (tPtr? tPtr->name : "null")));
                        IllegalExprOperandType(interp, opCode, valuePtr);
                        goto checkForCatch;
                    }
                }
                TRACE_WITH_OBJ(("uplus %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;
                Tcl_ObjType *tPtr;
 
                valuePtr = POP_OBJECT();
                tPtr = valuePtr->typePtr;
                if ((tPtr != &tclIntType) && (tPtr != &tclDoubleType)) {
                    char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
                    if (TclLooksLikeInt(s)) { /* FAILS IF NULLS */
                        result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
                                valuePtr, &i);
                    } else {
                        result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
                                valuePtr, &d);
                    }
                    if (result != TCL_OK) {
                        TRACE(("%s \"%.20s\" => ILLEGAL TYPE %s\n",
                                opName[opCode], s,
                               (tPtr? tPtr->name : "null")));
                        IllegalExprOperandType(interp, opCode, 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(
                                (opCode == INST_UMINUS)? -i : !i);
                        TRACE_WITH_OBJ(("%s %ld => ", opName[opCode], i),
                                objPtr); /* NB: stack top is off by 1 */
                    } else {
                        d = valuePtr->internalRep.doubleValue;
                        if (opCode == 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(("%s %.6g => ", opName[opCode], d),
                                objPtr); /* NB: stack top is off by 1 */
                    }
                    PUSH_OBJECT(objPtr);
                    TclDecrRefCount(valuePtr);
                } else {
                    /*
                     * valuePtr is unshared. Modify it directly.
                     */
                    if (tPtr == &tclIntType) {
                        i = valuePtr->internalRep.longValue;
                        Tcl_SetLongObj(valuePtr,
                                (opCode == INST_UMINUS)? -i : !i);
                        TRACE_WITH_OBJ(("%s %ld => ", opName[opCode], i),
                                valuePtr); /* NB: stack top is off by 1 */
                    } else {
                        d = valuePtr->internalRep.doubleValue;
                        if (opCode == 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(("%s %.6g => ", opName[opCode], d),
                                valuePtr); /* NB: stack top is off by 1 */
                    }
                    ++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(("bitnot \"%.20s\" => ILLEGAL TYPE %s\n",
                               O2S(valuePtr), (tPtr? tPtr->name : "null")));
                        IllegalExprOperandType(interp, opCode, valuePtr);
                        Tcl_DecrRefCount(valuePtr);
                        goto checkForCatch;
                    }
                }
 
                i = valuePtr->internalRep.longValue;
                if (Tcl_IsShared(valuePtr)) {
                    PUSH_OBJECT(Tcl_NewLongObj(~i));
                    TRACE(("bitnot 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(("bitnot 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;
 
                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();
                tcl_MathInProgress++;
                result = (*mathFuncPtr->proc)(interp, eePtr,
                        mathFuncPtr->clientData);
                tcl_MathInProgress--;
                CACHE_STACK_INFO();
                if (result != TCL_OK) {
                    goto checkForCatch;
                }
                TRACE_WITH_OBJ(("callBuiltinFunc1 %d => ", opnd),
                        stackPtr[stackTop].o);
            }
            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]. */
 
                objv = &(stackPtr[stackTop - (objc-1)].o); /* "objv[0]" */
                DECACHE_STACK_INFO();
                tcl_MathInProgress++;
                result = ExprCallMathFunc(interp, eePtr, objc, objv);
                tcl_MathInProgress--;
                CACHE_STACK_INFO();
                if (result != TCL_OK) {
                    goto checkForCatch;
                }
                TRACE_WITH_OBJ(("callFunc1 %d => ", objc),
                        stackPtr[stackTop].o);
                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].o;
                tPtr = valuePtr->typePtr;
                converted = 0;
                if ((tPtr != &tclIntType) && (tPtr != &tclDoubleType)) {
                    s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
                    if (TclLooksLikeInt(s)) { /* FAILS IF NULLS */
                        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 (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;
                        tPtr = valuePtr->typePtr;
                    } else {
                        Tcl_InvalidateStringRep(valuePtr);
                    }
                    stackPtr[stackTop].o = valuePtr;
 
                    if (tPtr == &tclDoubleType) {
                        d = valuePtr->internalRep.doubleValue;
                        if (IS_NAN(d) || IS_INF(d)) {
                            TRACE(("tryCvtToNumeric \"%.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(("tryCvtToNumeric \"%.20s\" => numeric, %s, %s\n",
                           O2S(valuePtr),
                           (converted? "converted" : "not converted"),
                           (shared? "shared" : "not shared")));
                } else {
                    TRACE(("tryCvtToNumeric \"%.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 = TclGetExceptionRangeForPc(pc, /*catchOnly*/ 0,
                    codePtr);
            if (rangePtr == NULL) {
                TRACE(("break => 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(("break => range at %d, new pc %d\n",
                       rangePtr->codeOffset, rangePtr->breakOffset));
                break;
            case CATCH_EXCEPTION_RANGE:
                result = TCL_BREAK;
                TRACE(("break => ...\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 = TclGetExceptionRangeForPc(pc, /*catchOnly*/ 0,
                    codePtr);
            if (rangePtr == NULL) {
                TRACE(("continue => 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(("continue => loop w/o continue, checking for catch\n"));
                    goto checkForCatch;
                } else {
                    result = TCL_OK;
                    TRACE(("continue => range at %d, new pc %d\n",
                           rangePtr->codeOffset, rangePtr->continueOffset));
                }
                break;
            case CATCH_EXCEPTION_RANGE:
                result = TCL_CONTINUE;
                TRACE(("continue => ...\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->loopIterNumTmp;
                CallFrame *varFramePtr = iPtr->varFramePtr;
                Var *compiledLocals = varFramePtr->compiledLocals;
                Var *iterVarPtr;
                Tcl_Obj *oldValuePtr;
 
                iterVarPtr = &(compiledLocals[iterTmpIndex]);
                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(("foreach_start4 %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;
                int iterTmpIndex = infoPtr->loopIterNumTmp;
                CallFrame *varFramePtr = iPtr->varFramePtr;
                Var *compiledLocals = varFramePtr->compiledLocals;
                int iterNum, listTmpIndex, listLen, numVars;
                int varIndex, valIndex, j;
                Tcl_Obj *listPtr, *elemPtr, *oldValuePtr;
                List *listRepPtr;
                Var *iterVarPtr, *listVarPtr;
                int continueLoop = 0;
 
                /*
                 * Increment the temp holding the loop iteration number.
                 */
 
                iterVarPtr = &(compiledLocals[iterTmpIndex]);
                oldValuePtr = iterVarPtr->value.objPtr;
                iterNum = (oldValuePtr->internalRep.longValue + 1);
                Tcl_SetLongObj(oldValuePtr, iterNum);
 
                /*
                 * Check whether all value lists are exhausted and we should
                 * stop the loop.
                 */
 
                listTmpIndex = infoPtr->firstListTmp;
                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(("foreach_step4 %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->firstListTmp;
                    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;
                                elemPtr = Tcl_NewObj();
                            } else {
                                elemPtr = listRepPtr->elements[valIndex];
                            }
 
                            varIndex = varListPtr->varIndexes[j];
                            DECACHE_STACK_INFO();
                            value2Ptr = TclSetIndexedScalar(interp,
                                   varIndex, elemPtr, /*leaveErrorMsg*/ 1);
                            CACHE_STACK_INFO();
                            if (value2Ptr == NULL) {
                                TRACE_WITH_OBJ(("foreach_step4 %u => ERROR init. index temp %d: ",
                                       opnd, varIndex),
                                       Tcl_GetObjResult(interp));
                                if (setEmptyStr) {
                                    Tcl_DecrRefCount(elemPtr); /* unneeded */
                                }
                                result = TCL_ERROR;
                                goto checkForCatch;
                            }
                            valIndex++;
                        }
                        listTmpIndex++;
                    }
                }
 
                /*
                 * Now push a "1" object if at least one value list had a
                 * remaining element and the loop should continue.
                 * Otherwise push "0".
                 */
 
                PUSH_OBJECT(Tcl_NewLongObj(continueLoop));
                TRACE(("foreach_step4 %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(("beginCatch4 %u => catchTop=%d, stackTop=%d\n",
                    TclGetUInt4AtPtr(pc+1), catchTop, stackTop));
            ADJUST_PC(5);
 
        case INST_END_CATCH:
            catchTop--;
            result = TCL_OK;
            TRACE(("endCatch => catchTop=%d\n", catchTop));
            ADJUST_PC(1);
 
        case INST_PUSH_RESULT:
            PUSH_OBJECT(Tcl_GetObjResult(interp));
            TRACE_WITH_OBJ(("pushResult => "), Tcl_GetObjResult(interp));
            ADJUST_PC(1);
 
        case INST_PUSH_RETURN_CODE:
            PUSH_OBJECT(Tcl_NewLongObj(result));
            TRACE(("pushReturnCode => %u\n", result));
            ADJUST_PC(1);
 
        default:
            TRACE(("UNRECOGNIZED INSTRUCTION %u\n", opCode));
            panic("TclExecuteByteCode: unrecognized opCode %u", opCode);
        } /* 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)) {
            RecordTracebackInfo(interp, pc, codePtr);
        }
        rangePtr = TclGetExceptionRangeForPc(pc, /*catchOnly*/ 1, codePtr);
        if (rangePtr == NULL) {
            TRACE(("   ... no enclosing catch, returning %s\n",
                    StringForResultCode(result)));
            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);
        }
        TRACE(("  ... found catch at %d, catchTop=%d, unwound to %d, new pc %u\n",
                rangePtr->codeOffset, catchTop, catchStackPtr[catchTop],
                (unsigned int)(rangePtr->catchOffset)));
        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
}
 
/*
 *----------------------------------------------------------------------
 *
 * 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;
    int numCmds = codePtr->numCommands;
    int numObjs = codePtr->numObjects;
    int objBytes, i;
 
    objBytes = (numObjs * sizeof(Tcl_Obj));
    for (i = 0;  i < numObjs;  i++) {
        Tcl_Obj *litObjPtr = codePtr->objArrayPtr[i];
        if (litObjPtr->bytes != NULL) {
            objBytes += litObjPtr->length;
        }
    }
 
    fprintf(stdout, "\nExecuting ByteCode 0x%x, ref ct %u, epoch %u, interp 0x%x(epoch %u)\n",
            (unsigned int) codePtr, codePtr->refCount,
            codePtr->compileEpoch, (unsigned int) codePtr->iPtr,
            codePtr->iPtr->compileEpoch);
 
    fprintf(stdout, "  Source: ");
    TclPrintSource(stdout, codePtr->source, 70);
 
    fprintf(stdout, "\n  Cmds %d, chars %d, inst %u, objs %u, aux %d, stk depth %u, code/src %.2fn",
            numCmds, codePtr->numSrcChars, codePtr->numCodeBytes, numObjs,
            codePtr->numAuxDataItems, codePtr->maxStackDepth,
            (codePtr->numSrcChars?
                    ((float)codePtr->totalSize)/((float)codePtr->numSrcChars) : 0.0));
 
    fprintf(stdout, "  Code %d = %d(header)+%d(inst)+%d(objs)+%d(exc)+%d(aux)+%d(cmd map)\n",
            codePtr->totalSize, sizeof(ByteCode), codePtr->numCodeBytes,
            objBytes, (codePtr->numExcRanges * sizeof(ExceptionRange)),
            (codePtr->numAuxDataItems * sizeof(AuxData)),
            codePtr->numCmdLocBytes);
 
    if (procPtr != NULL) {
        fprintf(stdout,
                "  Proc 0x%x, ref ct %d, args %d, compiled locals %d\n",
                (unsigned int) procPtr, procPtr->refCount,
                procPtr->numArgs, procPtr->numCompiledLocals);
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * 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 opCode holds the failing instruction's
 *      opcode and opndPtr holds the operand object in error.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      An error message is appended to errorInfo.
 *
 *----------------------------------------------------------------------
 */
 
static void
IllegalExprOperandType(interp, opCode, opndPtr)
    Tcl_Interp *interp;         /* Interpreter to which error information
                                 * pertains. */
    unsigned int opCode;        /* The instruction opcode being executed
                                 * when the illegal type was found. */
    Tcl_Obj *opndPtr;           /* Points to the operand holding the value
                                 * with the illegal type. */
{
    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 {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't use ",
                ((opndPtr->typePtr == &tclDoubleType) ?
                    "floating-point value" : "non-numeric string"),
                " 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.
     * THIS FAILS IF AN OBJECT'S STRING REP CONTAINS NULLS.
     */
 
    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);
}
 
/*
 *----------------------------------------------------------------------
 *
 * RecordTracebackInfo --
 *
 *      Procedure called by TclExecuteByteCode to record information
 *      about what was being executed when the error occurred.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Appends information about the command being executed to the
 *      "errorInfo" variable. Sets the errorLine field in the interpreter
 *      to the line number of that command. Sets the ERR_ALREADY_LOGGED
 *      bit in the interpreter's execution flags.
 *
 *----------------------------------------------------------------------
 */
 
static void
RecordTracebackInfo(interp, pc, codePtr)
    Tcl_Interp *interp;         /* The interpreter in which the error
                                 * occurred. */
    unsigned char *pc;          /* The program counter value where the error                                 * occurred. This points to a bytecode
                                 * instruction in codePtr's code. */
    ByteCode *codePtr;          /* The bytecode sequence being executed. */
{
    register Interp *iPtr = (Interp *) interp;
    char *cmd, *ellipsis;
    char buf[200];
    register char *p;
    int numChars;
 
    /*
     * Record the command in errorInfo (up to a certain number of
     * characters, or up to the first newline).
     */
 
    iPtr->errorLine = 1;
    cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
    if (cmd != NULL) {
        for (p = codePtr->source;  p != cmd;  p++) {
            if (*p == '\n') {
                iPtr->errorLine++;
            }
        }
        for ( ;  (isspace(UCHAR(*p)) || (*p == ';'));  p++) {
            if (*p == '\n') {
                iPtr->errorLine++;
            }
        }
 
        ellipsis = "";
        if (numChars > 150) {
            numChars = 150;
            ellipsis = "...";
        }
        if (!(iPtr->flags & ERR_IN_PROGRESS)) {
            sprintf(buf, "\n    while executing\n\"%.*s%s\"",
                    numChars, cmd, ellipsis);
        } else {
            sprintf(buf, "\n    invoked from within\n\"%.*s%s\"",
                    numChars, cmd, ellipsis);
        }
        Tcl_AddObjErrorInfo(interp, buf, -1);
        iPtr->flags |= ERR_ALREADY_LOGGED;
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * 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);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclGetExceptionRangeForPc --
 *
 *      Procedure that given a program counter value, returns the closest
 *      enclosing ExceptionRange that matches the kind requested.
 *
 * 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 (true), 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.
 *
 *----------------------------------------------------------------------
 */
 
ExceptionRange *
TclGetExceptionRangeForPc(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. Otherwise
                                 * 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 = codePtr->excRangeArrayPtr;
    int numRanges = codePtr->numExcRanges;
    register ExceptionRange *rangePtr;
    int codeOffset = (pc - codePtr->codeStart);
    register int i, level;
 
    for (level = codePtr->maxExcRangeDepth;  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 <= codeOffset) && (codeOffset < end)) {
                    if ((!catchOnly)
                            || (rangePtr->type == CATCH_EXCEPTION_RANGE)) {
                        return rangePtr;
                    }
                }
            }
        }
    }
    return NULL;
}
 
/*
 *----------------------------------------------------------------------
 *
 * 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. */
{
    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
    register int stackTop;      /* Cached top index of evaluation stack. */
    register Tcl_Obj *valuePtr;
    Tcl_ObjType *tPtr;
    double d, dResult;
    long i;
    int result = TCL_OK;
 
    double (*func) _ANSI_ARGS_((double)) =
        (double (*)_ANSI_ARGS_((double))) clientData;
 
    /*
     * Set stackPtr and stackTop from eePtr.
     */
 
    CACHE_STACK_INFO();
 
    /*
     * Pop the function's argument from the evaluation stack. Convert it
     * to a double if necessary.
     */
 
    valuePtr = POP_OBJECT();
    tPtr = valuePtr->typePtr;
 
    if (tPtr == &tclIntType) {
        d = (double) valuePtr->internalRep.longValue;
    } else if (tPtr == &tclDoubleType) {
        d = valuePtr->internalRep.doubleValue;
    } else {                    /* FAILS IF STRING REP HAS NULLS */
        char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
 
        if (TclLooksLikeInt(s)) {
            result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
            d = (double) valuePtr->internalRep.longValue;
        } else {
            result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
        }
        if (result != TCL_OK) {
            Tcl_ResetResult(interp);
            Tcl_AppendToObj(Tcl_GetObjResult(interp),
                    "argument to math function didn't have numeric value", -1);
            goto done;
        }
    }
 
    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. */
{
    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
    register int stackTop;      /* Cached top index of evaluation stack. */
    register Tcl_Obj *valuePtr, *value2Ptr;
    Tcl_ObjType *tPtr;
    double d1, d2, dResult;
    long i;
    char *s;
    int result = TCL_OK;
 
    double (*func) _ANSI_ARGS_((double, double))
        = (double (*)_ANSI_ARGS_((double, double))) clientData;
 
    /*
     * Set stackPtr and stackTop from eePtr.
     */
 
    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();
 
    tPtr = valuePtr->typePtr;
    if (tPtr == &tclIntType) {
        d1 = (double) valuePtr->internalRep.longValue;
    } else if (tPtr == &tclDoubleType) {
        d1 = valuePtr->internalRep.doubleValue;
    } else {                    /* FAILS IF STRING REP HAS NULLS */
        s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
        if (TclLooksLikeInt(s)) {
            result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
            d1 = (double) valuePtr->internalRep.longValue;
        } else {
            result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d1);
        }
        if (result != TCL_OK) {
            badArg:
            Tcl_ResetResult(interp);
            Tcl_AppendToObj(Tcl_GetObjResult(interp),
                    "argument to math function didn't have numeric value", -1);
            goto done;
        }
    }
 
    tPtr = value2Ptr->typePtr;
    if (tPtr == &tclIntType) {
        d2 = value2Ptr->internalRep.longValue;
    } else if (tPtr == &tclDoubleType) {
        d2 = value2Ptr->internalRep.doubleValue;
    } else {                    /* FAILS IF STRING REP HAS NULLS */
        s = Tcl_GetStringFromObj(value2Ptr, (int *) NULL);
        if (TclLooksLikeInt(s)) {
            result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, value2Ptr, &i);
            d2 = (double) value2Ptr->internalRep.longValue;
        } else {
            result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, value2Ptr, &d2);
        }
        if (result != TCL_OK) {
            goto badArg;
        }
    }
 
    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. */
{
    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
    register int stackTop;      /* Cached top index of evaluation stack. */
    register Tcl_Obj *valuePtr;
    Tcl_ObjType *tPtr;
    long i, iResult;
    double d, dResult;
    int result = TCL_OK;
 
    /*
     * Set stackPtr and stackTop from eePtr.
     */
 
    CACHE_STACK_INFO();
 
    /*
     * Pop the argument from the evaluation stack.
     */
 
    valuePtr = POP_OBJECT();
    tPtr = valuePtr->typePtr;
 
    if (tPtr == &tclIntType) {
        i = valuePtr->internalRep.longValue;
    } else if (tPtr == &tclDoubleType) {
        d = valuePtr->internalRep.doubleValue;
    } else {                    /* FAILS IF STRING REP HAS NULLS */
        char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
 
        if (TclLooksLikeInt(s)) {
            result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
        } else {
            result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
        }
        if (result != TCL_OK) {
            Tcl_ResetResult(interp);
            Tcl_AppendToObj(Tcl_GetObjResult(interp),
                    "argument to math function didn't have numeric value", -1);
            goto done;
        }
        tPtr = valuePtr->typePtr;
    }
 
    /*
     * Push a Tcl object with the result.
     */
 
    if (tPtr == &tclIntType) {
        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 {
        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. */
{
    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
    register int stackTop;      /* Cached top index of evaluation stack. */
    register Tcl_Obj *valuePtr;
    double dResult;
    long i;
    int result = TCL_OK;
 
    /*
     * Set stackPtr and stackTop from eePtr.
     */
 
    CACHE_STACK_INFO();
 
    /*
     * Pop the argument from the evaluation stack.
     */
 
    valuePtr = POP_OBJECT();
    if (valuePtr->typePtr == &tclIntType) {
        dResult = (double) valuePtr->internalRep.longValue;
    } else if (valuePtr->typePtr == &tclDoubleType) {
        dResult = valuePtr->internalRep.doubleValue;
    } else {                    /* FAILS IF STRING REP HAS NULLS */
        char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
 
        if (TclLooksLikeInt(s)) {
            result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
            dResult = (double) valuePtr->internalRep.longValue;
        } else {
            result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr,
                    &dResult);
        }
        if (result != TCL_OK) {
            Tcl_ResetResult(interp);
            Tcl_AppendToObj(Tcl_GetObjResult(interp),
                    "argument to math function didn't have numeric value", -1);
            goto done;
        }
    }
 
    /*
     * 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. */
{
    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
    register int stackTop;      /* Cached top index of evaluation stack. */
    register Tcl_Obj *valuePtr;
    Tcl_ObjType *tPtr;
    long i = 0;                  /* Initialized to avoid compiler warning. */
    long iResult;
    double d;
    int result = TCL_OK;
 
    /*
     * Set stackPtr and stackTop from eePtr.
     */
 
    CACHE_STACK_INFO();
 
    /*
     * Pop the argument from the evaluation stack.
     */
 
    valuePtr = POP_OBJECT();
    tPtr = valuePtr->typePtr;
 
    if (tPtr == &tclIntType) {
        i = valuePtr->internalRep.longValue;
    } else if (tPtr == &tclDoubleType) {
        d = valuePtr->internalRep.doubleValue;
    } else {                    /* FAILS IF STRING REP HAS NULLS */
        char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
 
        if (TclLooksLikeInt(s)) {
            result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
        } else {
            result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
        }
        if (result != TCL_OK) {
            Tcl_ResetResult(interp);
            Tcl_AppendToObj(Tcl_GetObjResult(interp),
                    "argument to math function didn't have numeric value", -1);
            goto done;
        }
        tPtr = valuePtr->typePtr;
    }
 
    /*
     * Push a Tcl object with the result.
     */
 
    if (tPtr == &tclIntType) {
        iResult = i;
    } else {
        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_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. */
{
    StackItem *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. */
{
    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
    register int stackTop;      /* Cached top index of evaluation stack. */
    Tcl_Obj *valuePtr;
    Tcl_ObjType *tPtr;
    long i = 0;                  /* Initialized to avoid compiler warning. */
    long iResult;
    double d, temp;
    int result = TCL_OK;
 
    /*
     * Set stackPtr and stackTop from eePtr.
     */
 
    CACHE_STACK_INFO();
 
    /*
     * Pop the argument from the evaluation stack.
     */
 
    valuePtr = POP_OBJECT();
    tPtr = valuePtr->typePtr;
 
    if (tPtr == &tclIntType) {
        i = valuePtr->internalRep.longValue;
    } else if (tPtr == &tclDoubleType) {
        d = valuePtr->internalRep.doubleValue;
    } else {                    /* FAILS IF STRING REP HAS NULLS */
        char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
 
        if (TclLooksLikeInt(s)) {
            result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
        } else {
            result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
        }
        if (result != TCL_OK) {
            Tcl_ResetResult(interp);
            Tcl_AppendToObj(Tcl_GetObjResult(interp),
                    "argument to math function didn't have numeric value", -1);
            goto done;
        }
        tPtr = valuePtr->typePtr;
    }
 
    /*
     * Push a Tcl object with the result.
     */
 
    if (tPtr == &tclIntType) {
        iResult = i;
    } else {
        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_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. */
{
    StackItem *stackPtr;        /* Cached evaluation stack base pointer. */
    register int stackTop;      /* Cached top index of evaluation stack. */
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *valuePtr;
    Tcl_ObjType *tPtr;
    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();
    tPtr = valuePtr->typePtr;
 
    if (tPtr == &tclIntType) {
        i = valuePtr->internalRep.longValue;
    } else {                    /* FAILS IF STRING REP HAS NULLS */
        result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
        if (result != TCL_OK) {
            Tcl_ResetResult(interp);
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't use ",
                    ((tPtr == &tclDoubleType)? "floating-point value" : "non-numeric string"),
                    " as argument to srand", (char *) NULL);
            Tcl_DecrRefCount(valuePtr);
            DECACHE_STACK_INFO();
            return result;
        }
    }
 
    /*
     * 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;
    StackItem *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;
    Tcl_ObjType *tPtr;
    long i;
    double d;
    int j, k, result;
 
    Tcl_ResetResult(interp);
 
    /*
     * Set stackPtr and stackTop from eePtr.
     */
 
    CACHE_STACK_INFO();
 
    /*
     * Look up the MathFunc record for the function.
     * THIS FAILS IF THE OBJECT'S STRING REP CONTAINS NULLS.
     */
 
    funcName = Tcl_GetStringFromObj(objv[0], (int *) NULL);
    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];
        tPtr = valuePtr->typePtr;
 
        if (tPtr == &tclIntType) {
            i = valuePtr->internalRep.longValue;
        } else if (tPtr == &tclDoubleType) {
            d = valuePtr->internalRep.doubleValue;
        } else {
            /*
             * Try to convert to int first then double.
             * FAILS IF STRING REP HAS NULLS.
             */
 
            char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
 
            if (TclLooksLikeInt(s)) {
                result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
            } else {
                result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
                        valuePtr, &d);
            }
            if (result != TCL_OK) {
                Tcl_AppendToObj(Tcl_GetObjResult(interp),
                        "argument to math function didn't have numeric value", -1);
                goto done;
            }
            tPtr = valuePtr->typePtr;
        }
 
        /*
         * Copy the object's numeric value to the argument record,
         * converting it if necessary.
         */
 
        if (tPtr == &tclIntType) {
            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 {
            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.
     */
 
    tcl_MathInProgress++;
    result = (*mathFuncPtr->proc)(mathFuncPtr->clientData, interp, args,
            &funcResult);
    tcl_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].o;
        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 {                    /* FAILS IF STRING REP CONTAINS NULLS */
        char msg[100];
 
        sprintf(msg, "unknown floating-point error, errno = %d", errno);
        Tcl_AppendToObj(Tcl_GetObjResult(interp), msg, -1);
        Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN", msg, (char *) NULL);
    }
}
 
#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. */
{
    register double total = 0.0;
    register int i;
    int maxSizeDecade = 0;
    double totalHeaderBytes = (tclNumCompilations * sizeof(ByteCode));
 
    for (i = 0;  i < 256;  i++) {
        if (instructionCount[i] != 0) {
            total += instructionCount[i];
        }
    }
 
    for (i = 31;  i >= 0;  i--) {
        if ((tclSourceCount[i] > 0) && (tclByteCodeCount[i] > 0)) {
            maxSizeDecade = i;
            break;
        }
    }
 
    fprintf(stdout, "\nNumber of compilations           %ld\n",
            tclNumCompilations);
    fprintf(stdout, "Number of executions               %ld\n",
            numExecutions);
    fprintf(stdout, "Average executions/compilation     %.0f\n",
            ((float) numExecutions/tclNumCompilations));
 
    fprintf(stdout, "\nInstructions executed            %.0f\n",
            total);
    fprintf(stdout, "Average instructions/compile       %.0f\n",
            total/tclNumCompilations);
    fprintf(stdout, "Average instructions/execution     %.0f\n",
            total/numExecutions);
 
    fprintf(stdout, "\nTotal source bytes               %.6g\n",
            tclTotalSourceBytes);
    fprintf(stdout, "Total code bytes           %.6g\n",
            tclTotalCodeBytes);
    fprintf(stdout, "Average code/compilation   %.0f\n",
            tclTotalCodeBytes/tclNumCompilations);
    fprintf(stdout, "Average code/source                %.2f\n",
            tclTotalCodeBytes/tclTotalSourceBytes);
    fprintf(stdout, "Current source bytes               %.6g\n",
            tclCurrentSourceBytes);
    fprintf(stdout, "Current code bytes         %.6g\n",
            tclCurrentCodeBytes);
    fprintf(stdout, "Current code/source                %.2f\n",
            tclCurrentCodeBytes/tclCurrentSourceBytes);
 
    fprintf(stdout, "\nTotal objects allocated          %ld\n",
            tclObjsAlloced);
    fprintf(stdout, "Total objects freed                %ld\n",
            tclObjsFreed);
    fprintf(stdout, "Current objects:           %ld\n",
            (tclObjsAlloced - tclObjsFreed));
 
    fprintf(stdout, "\nBreakdown of code byte requirements:\n");
    fprintf(stdout, "                   Total bytes      Pct of    Avg per\n");
    fprintf(stdout, "                                  all code    compile\n");
    fprintf(stdout, "Total code        %12.6g        100%%   %8.2f\n",
            tclTotalCodeBytes, tclTotalCodeBytes/tclNumCompilations);
    fprintf(stdout, "Header            %12.6g   %8.2f%%   %8.2f\n",
            totalHeaderBytes,
            ((totalHeaderBytes * 100.0) / tclTotalCodeBytes),
            totalHeaderBytes/tclNumCompilations);
    fprintf(stdout, "Instructions      %12.6g   %8.2f%%   %8.2f\n",
            tclTotalInstBytes,
            ((tclTotalInstBytes * 100.0) / tclTotalCodeBytes),
            tclTotalInstBytes/tclNumCompilations);
    fprintf(stdout, "Objects           %12.6g   %8.2f%%   %8.2f\n",
            tclTotalObjBytes,
            ((tclTotalObjBytes * 100.0) / tclTotalCodeBytes),
            tclTotalObjBytes/tclNumCompilations);
    fprintf(stdout, "Exception table   %12.6g   %8.2f%%   %8.2f\n",
            tclTotalExceptBytes,
            ((tclTotalExceptBytes * 100.0) / tclTotalCodeBytes),
            tclTotalExceptBytes/tclNumCompilations);
    fprintf(stdout, "Auxiliary data    %12.6g   %8.2f%%   %8.2f\n",
            tclTotalAuxBytes,
            ((tclTotalAuxBytes * 100.0) / tclTotalCodeBytes),
            tclTotalAuxBytes/tclNumCompilations);
    fprintf(stdout, "Command map       %12.6g   %8.2f%%   %8.2f\n",
            tclTotalCmdMapBytes,
            ((tclTotalCmdMapBytes * 100.0) / tclTotalCodeBytes),
            tclTotalCmdMapBytes/tclNumCompilations);
 
    fprintf(stdout, "\nSource and ByteCode size distributions:\n");
    fprintf(stdout, "    binary decade          source    code\n");
    for (i = 0;  i <= maxSizeDecade;  i++) {
        int decadeLow, decadeHigh;
 
        if (i == 0) {
            decadeLow = 0;
        } else {
            decadeLow = 1 << i;
        }
        decadeHigh = (1 << (i+1)) - 1;
        fprintf(stdout, "       %6d -%6d                %6d     %6d\n",
                decadeLow, decadeHigh,
                tclSourceCount[i], tclByteCodeCount[i]);
    }
 
    fprintf(stdout, "\nInstruction counts:\n");
    for (i = 0;  i < 256;  i++) {
        if (instructionCount[i]) {
            fprintf(stdout, "%20s %8d %6.2f%%\n",
                    opName[i], instructionCount[i],
                    (instructionCount[i] * 100.0)/total);
        }
    }
 
#ifdef TCL_MEM_DEBUG
    fprintf(stdout, "\nHeap Statistics:\n");
    TclDumpMemoryInfo(stdout);
#endif /* TCL_MEM_DEBUG */
 
    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;
        }
    }
 
    if (cmdPtr == NULL) {
        return (Tcl_Command) NULL;
    }
    return (Tcl_Command) cmdPtr;
}
 
/*
 *----------------------------------------------------------------------
 *
 * 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_GetStringFromObj(objPtr, (int *) NULL);
    }
 
    /*
     * 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;
}
 
/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfCmdName --
 *
 *      Update the string representation for an cmdName object.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Generates a panic.
 *
 *----------------------------------------------------------------------
 */
 
static void
UpdateStringOfCmdName(objPtr)
    Tcl_Obj *objPtr;            /* CmdName obj to update string rep. */
{
    /*
     * This procedure is never invoked since the internal representation of
     * a cmdName object is never modified.
     */
 
    panic("UpdateStringOfCmdName should never be invoked");
}
 
#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[20];
 
    if ((result >= TCL_OK) && (result <= TCL_CONTINUE)) {
        return resultStrings[result];
    }
    TclFormatInt(buf, result);
    return buf;
}
#endif /* TCL_COMPILE_DEBUG */
Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [generic/] [tclExecute.c] - Blame information for rev 1767

Line No.	Rev	Author	Line
1	578	markom	`/*`
2			`* tclExecute.c --`
3			`*`
4			`* This file contains procedures that execute byte-compiled Tcl`
5			`* commands.`
6			`*`
7			`* Copyright (c) 1996-1997 Sun Microsystems, Inc.`
8			`*`
9			`* See the file "license.terms" for information on usage and redistribution`
10			`* of this file, and for a DISCLAIMER OF ALL WARRANTIES.`
11			`*`
12			`* RCS: @(#) $Id: tclExecute.c,v 1.1.1.1 2002-01-16 10:25:27 markom Exp $`
13			`*/`
14
15			`#include "tclInt.h"`
16			`#include "tclCompile.h"`
17
18			`#ifdef NO_FLOAT_H`
19			`# include "../compat/float.h"`
20			`#else`
21			`# include <float.h>`
22			`#endif`
23			`#ifndef TCL_NO_MATH`
24			`#include "tclMath.h"`
25			`#endif`
26
27			`/*`
28			`* The stuff below is a bit of a hack so that this file can be used`
29			`* in environments that include no UNIX, i.e. no errno. Just define`
30			`* errno here.`
31			`*/`
32
33			`#ifndef TCL_GENERIC_ONLY`
34			`#include "tclPort.h"`
35			`#else`
36			`#define NO_ERRNO_H`
37			`#endif`
38
39			`#ifdef NO_ERRNO_H`
40			`int errno;`