#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
#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
static int execInitialized = 0;
int tclTraceExec = 0;
int tcl_MathInProgress = 0;
#ifdef NEED_MATHERR
extern int matherr();
int (*tclMatherrPtr)() = matherr;
#endif
static char *opName[256];
static char *operatorStrings[] = {
"||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
"+", "-", "*", "/", "%", "+", "-", "~", "!",
"BUILTIN FUNCTION", "FUNCTION"
};
#ifdef TCL_COMPILE_DEBUG
static char *resultStrings[] = {
"TCL_OK", "TCL_ERROR", "TCL_RETURN", "TCL_BREAK", "TCL_CONTINUE"
};
#endif
#ifdef TCL_COMPILE_STATS
static long numExecutions = 0;
static int instructionCount[256];
#endif
#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
#define ADJUST_PC(instBytes) \
pc += instBytes; continue
#define CACHE_STACK_INFO() \
stackPtr = eePtr->stackPtr; \
stackTop = eePtr->stackTop
#define DECACHE_STACK_INFO() \
eePtr->stackTop = stackTop
#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)
#define PUSH_OBJECT(objPtr) \
Tcl_IncrRefCount(stackPtr[++stackTop].o = (objPtr))
#define POP_OBJECT() \
(stackPtr[stackTop--].o)
#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
#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
#else
#define TRACE(a)
#define TRACE_WITH_OBJ(a, objPtr)
#define O2S(objPtr)
#endif
static void CallTraceProcedure _ANSI_ARGS_((Tcl_Interp *interp,
Trace *tracePtr, Command *cmdPtr,
char *command, int numChars,
int objc, Tcl_Obj *objv[]));
static void DupCmdNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
Tcl_Obj *copyPtr));
static int ExprAbsFunc _ANSI_ARGS_((Tcl_Interp *interp,
ExecEnv *eePtr, ClientData clientData));
static int ExprBinaryFunc _ANSI_ARGS_((Tcl_Interp *interp,
ExecEnv *eePtr, ClientData clientData));
static int ExprCallMathFunc _ANSI_ARGS_((Tcl_Interp *interp,
ExecEnv *eePtr, int objc, Tcl_Obj **objv));
static int ExprDoubleFunc _ANSI_ARGS_((Tcl_Interp *interp,
ExecEnv *eePtr, ClientData clientData));
static int ExprIntFunc _ANSI_ARGS_((Tcl_Interp *interp,
ExecEnv *eePtr, ClientData clientData));
static int ExprRandFunc _ANSI_ARGS_((Tcl_Interp *interp,
ExecEnv *eePtr, ClientData clientData));
static int ExprRoundFunc _ANSI_ARGS_((Tcl_Interp *interp,
ExecEnv *eePtr, ClientData clientData));
static int ExprSrandFunc _ANSI_ARGS_((Tcl_Interp *interp,
ExecEnv *eePtr, ClientData clientData));
static int ExprUnaryFunc _ANSI_ARGS_((Tcl_Interp *interp,
ExecEnv *eePtr, ClientData clientData));
#ifdef TCL_COMPILE_STATS
static int EvalStatsCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int argc, char **argv));
#endif
static void FreeCmdNameInternalRep _ANSI_ARGS_((
Tcl_Obj *objPtr));
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
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
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},
{"round", 1, {TCL_EITHER}, ExprRoundFunc, 0},
{"srand", 1, {TCL_INT}, ExprSrandFunc, 0},
{0},
};
Tcl_ObjType tclCmdNameType = {
"cmdName",
FreeCmdNameInternalRep,
DupCmdNameInternalRep,
UpdateStringOfCmdName,
SetCmdNameFromAny
};
static void
InitByteCodeExecution(interp)
Tcl_Interp *interp;
{
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
if (Tcl_LinkVar(interp, "tcl_traceExec", (char *) &tclTraceExec,
TCL_LINK_INT) != TCL_OK) {
panic("InitByteCodeExecution: can't create link for tcl_traceExec variable");
}
}
#define TCL_STACK_INITIAL_SIZE 2000
ExecEnv *
TclCreateExecEnv(interp)
Tcl_Interp *interp;
{
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
void
TclDeleteExecEnv(eePtr)
ExecEnv *eePtr;
{
ckfree((char *) eePtr->stackPtr);
ckfree((char *) eePtr);
}
void
TclFinalizeExecEnv()
{
execInitialized = 0;
TclFinalizeAuxDataTypeTable();
}
static void
GrowEvaluationStack(eePtr)
register ExecEnv *eePtr;
{
int currElems = (eePtr->stackEnd + 1);
int newElems = 2*currElems;
int currBytes = currElems * sizeof(StackItem);
int newBytes = 2*currBytes;
StackItem *newStackPtr = (StackItem *) ckalloc((unsigned) newBytes);
memcpy((VOID *) newStackPtr, (VOID *) eePtr->stackPtr,
(size_t) currBytes);
ckfree((char *) eePtr->stackPtr);
eePtr->stackPtr = newStackPtr;
eePtr->stackEnd = (newElems - 1);
}
int
TclExecuteByteCode(interp, codePtr)
Tcl_Interp *interp;
ByteCode *codePtr;
{
Interp *iPtr = (Interp *) interp;
ExecEnv *eePtr = iPtr->execEnvPtr;
register StackItem *stackPtr = eePtr->stackPtr;
register int stackTop = eePtr->stackTop;
Tcl_Obj **objArrayPtr = codePtr->objArrayPtr;
unsigned char *pc = codePtr->codeStart;
unsigned char opCode;
int opnd;
int pcAdjustment;
int initStackTop = stackTop;
ExceptionRange *rangePtr;
int result = TCL_OK;
int traceInstructions = (tclTraceExec == 3);
Tcl_Obj *valuePtr, *value2Ptr, *namePtr, *objPtr;
char *bytes;
int length;
long i;
Tcl_DString command;
#define STATIC_CATCH_STACK_SIZE 5
int (catchStackStorage[STATIC_CATCH_STACK_SIZE]);
int *catchStackPtr = catchStackStorage;
int catchTop = -1;
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
fflush(stdout);
}
#ifdef TCL_COMPILE_STATS
numExecutions++;
#endif
if (codePtr->maxExcRangeDepth > STATIC_CATCH_STACK_SIZE) {
catchStackPtr = (int *)
ckalloc(codePtr->maxExcRangeDepth * sizeof(int));
}
while ((stackTop + codePtr->maxStackDepth) > eePtr->stackEnd) {
GrowEvaluationStack(eePtr);
stackPtr = eePtr->stackPtr;
}
Tcl_DStringInit(&command);
for (;;) {
#ifdef TCL_COMPILE_DEBUG
ValidatePcAndStackTop(codePtr, pc, stackTop, initStackTop,
eePtr->stackEnd);
#else
if (traceInstructions) {
#ifdef TCL_COMPILE_STATS
fprintf(stdout, "%d: %d,%ld ", iPtr->numLevels, stackTop,
(tclObjsAlloced - tclObjsFreed));
#else
fprintf(stdout, "%d: %d ", iPtr->numLevels, stackTop);
#endif
TclPrintInstruction(codePtr, pc);
fflush(stdout);
}
#endif
opCode = *pc;
#ifdef TCL_COMPILE_STATS
instructionCount[opCode]++;
#endif
switch (opCode) {
case INST_DONE:
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);
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;
for (i = (stackTop - (opnd-1)); i <= stackTop; i++) {
valuePtr = stackPtr[i].o;
bytes = TclGetStringFromObj(valuePtr, &length);
if (bytes != NULL) {
totalLen += length;
}
}
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;
int objc = opnd;
Tcl_Obj **objv;
Tcl_Obj *objv0Ptr;
int newPcOffset = 0;
Tcl_Command cmd;
#ifdef TCL_COMPILE_DEBUG
int isUnknownCmd = 0;
char cmdNameBuf[30];
#endif
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);
cmd = Tcl_GetCommandFromObj(interp, objv0Ptr);
cmdPtr = (Command *) cmd;
if (cmdPtr == NULL) {
cmd = Tcl_FindCommand(interp, "unknown",
(Tcl_Namespace *) NULL, 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
stackTop++;
for (i = objc; i >= 0; i--) {
objv[i+1] = objv[i];
}
objc++;
objv[0] = Tcl_NewStringObj("unknown", -1);
Tcl_IncrRefCount(objv[0]);
}
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();
}
}
}
}
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) {
strncpy(cmdNameBuf, cmdName, 20);
TRACE(("%s %u => call ", opName[opCode],
(isUnknownCmd? objc-1 : objc)));
} else {
fprintf(stdout, "%s", buffer);
}
#else
fprintf(stdout, "%s", buffer);
#endif
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 (*(iPtr->result) != 0) {
(void) Tcl_GetObjResult(interp);
}
i = (stackTop - (objc-1));
while (i <= stackTop) {
valuePtr = stackPtr[i].o;
TclDecrRefCount(valuePtr);
i++;
}
stackTop -= objc;
switch (result) {
case TCL_OK:
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:
rangePtr = TclGetExceptionRangeForPc(pc,
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;
}
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;
default:
panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
}
result = TCL_OK;
pc = (codePtr->codeStart + newPcOffset);
continue;
case TCL_ERROR:
TRACE_WITH_OBJ(("%s %u => ... after \"%.20s\", TCL_ERROR ",
opName[opCode], objc, cmdNameBuf),
Tcl_GetObjResult(interp));
goto checkForCatch;
case TCL_RETURN:
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;
}
}
case INST_EVAL_STK:
objPtr = POP_OBJECT();
DECACHE_STACK_INFO();
result = Tcl_EvalObj(interp, objPtr);
CACHE_STACK_INFO();
if (result == TCL_OK) {
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)) {
int newPcOffset = 0;
rangePtr = TclGetExceptionRangeForPc(pc, 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;
}
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;
default:
panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
}
Tcl_DecrRefCount(objPtr);
pc = (codePtr->codeStart + newPcOffset);
continue;
} else {
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;
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,
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, 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,
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,
(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,
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,
(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,
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:
{
int i1, i2;
int iResult;
char *s;
Tcl_ObjType *t1Ptr, *t2Ptr;
value2Ptr = POP_OBJECT();
valuePtr = POP_OBJECT();
t1Ptr = valuePtr->typePtr;
t2Ptr = value2Ptr->typePtr;
if ((t1Ptr == &tclIntType) || (t1Ptr == &tclBooleanType)) {
i1 = (valuePtr->internalRep.longValue != 0);
} else if (t1Ptr == &tclDoubleType) {
i1 = (valuePtr->internalRep.doubleValue != 0.0);
} else {
s = Tcl_GetStringFromObj(valuePtr, (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 {
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;
}
}
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 {
TRACE(("%s %.20s %.20s => %d\n",
opName[opCode],
O2S(valuePtr), O2S(value2Ptr), iResult));
Tcl_SetLongObj(valuePtr, iResult);
++stackTop;
}
TclDecrRefCount(value2Ptr);
}
ADJUST_PC(1);
case INST_EQ:
case INST_NEQ:
case INST_LT:
case INST_GT:
case INST_LE:
case INST_GE:
{
Tcl_ObjType *t1Ptr, *t2Ptr;
char *s1 = NULL;
char *s2 = NULL;
long i2 = 0;
double d1 = 0.0;
double d2 = 0.0;
long iResult = 0;
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)) {
(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)) {
(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))) {
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)) {
if (t1Ptr == &tclDoubleType) {
d1 = valuePtr->internalRep.doubleValue;
if (t2Ptr == &tclIntType) {
d2 = value2Ptr->internalRep.longValue;
} else {
d2 = value2Ptr->internalRep.doubleValue;
}
} else {
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 {
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;
}
}
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 {
TRACE(("%s %.20s %.20s => %ld\n",
opName[opCode],
O2S(valuePtr), O2S(value2Ptr), iResult));
Tcl_SetLongObj(valuePtr, iResult);
++stackTop;
}
TclDecrRefCount(value2Ptr);
}
ADJUST_PC(1);
case INST_MOD:
case INST_LSHIFT:
case INST_RSHIFT:
case INST_BITOR:
case INST_BITXOR:
case INST_BITAND:
{
long i2, rem, negative;
long iResult = 0;
value2Ptr = POP_OBJECT();
valuePtr = POP_OBJECT();
if (valuePtr->typePtr == &tclIntType) {
i = valuePtr->internalRep.longValue;
} else {
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:
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:
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;
}
if (Tcl_IsShared(valuePtr)) {
PUSH_OBJECT(Tcl_NewLongObj(iResult));
TRACE(("%s %ld %ld => %ld\n", opName[opCode], i, i2,
iResult));
TclDecrRefCount(valuePtr);
} else {
TRACE(("%s %ld %ld => %ld\n", opName[opCode], i, i2,
iResult));
Tcl_SetLongObj(valuePtr, iResult);
++stackTop;
}
TclDecrRefCount(value2Ptr);
}
ADJUST_PC(1);
case INST_ADD:
case INST_SUB:
case INST_MULT:
case INST_DIV:
{
Tcl_ObjType *t1Ptr, *t2Ptr;
long i2, quot, rem;
double d1, d2;
long iResult = 0;
double dResult = 0.0;
int doDouble = 0;
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 {
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 {
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)) {
doDouble = 1;
if (t1Ptr == &tclIntType) {
d1 = i;
} else if (t2Ptr == &tclIntType) {
d2 = i2;
}
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;
}
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 {
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:
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;
}
}
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 {
if (doDouble) {
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;
}
TclDecrRefCount(value2Ptr);
}
ADJUST_PC(1);
case INST_UPLUS:
{
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)) {
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:
{
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)) {
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)) {
if (tPtr == &tclIntType) {
i = valuePtr->internalRep.longValue;
objPtr = Tcl_NewLongObj(
(opCode == INST_UMINUS)? -i : !i);
TRACE_WITH_OBJ(("%s %ld => ", opName[opCode], i),
objPtr);
} else {
d = valuePtr->internalRep.doubleValue;
if (opCode == INST_UMINUS) {
objPtr = Tcl_NewDoubleObj(-d);
} else {
objPtr = Tcl_NewLongObj((d==0.0)? 1 : 0);
}
TRACE_WITH_OBJ(("%s %.6g => ", opName[opCode], d),
objPtr);
}
PUSH_OBJECT(objPtr);
TclDecrRefCount(valuePtr);
} else {
if (tPtr == &tclIntType) {
i = valuePtr->internalRep.longValue;
Tcl_SetLongObj(valuePtr,
(opCode == INST_UMINUS)? -i : !i);
TRACE_WITH_OBJ(("%s %ld => ", opName[opCode], i),
valuePtr);
} else {
d = valuePtr->internalRep.doubleValue;
if (opCode == INST_UMINUS) {
Tcl_SetDoubleObj(valuePtr, -d);
} else {
Tcl_SetLongObj(valuePtr, (d==0.0)? 1 : 0);
}
TRACE_WITH_OBJ(("%s %.6g => ", opName[opCode], d),
valuePtr);
}
++stackTop;
}
}
ADJUST_PC(1);
case INST_BITNOT:
{
Tcl_ObjType *tPtr;
valuePtr = POP_OBJECT();
tPtr = valuePtr->typePtr;
if (tPtr != &tclIntType) {
result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
valuePtr, &i);
if (result != TCL_OK) {
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 {
Tcl_SetLongObj(valuePtr, ~i);
++stackTop;
TRACE(("bitnot 0x%lx => (%lu)\n", i, ~i));
}
}
ADJUST_PC(1);
case INST_CALL_BUILTIN_FUNC1:
opnd = TclGetUInt1AtPtr(pc+1);
{
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);
{
int objc = opnd;
Tcl_Obj **objv;
objv = &(stackPtr[stackTop - (objc-1)].o);
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:
{
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)) {
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;
tPtr = valuePtr->typePtr;
}
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;
converted = converted;
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:
Tcl_ResetResult(interp);
rangePtr = TclGetExceptionRangeForPc(pc, 0,
codePtr);
if (rangePtr == NULL) {
TRACE(("break => no encl. loop or catch, returning TCL_BREAK\n"));
result = TCL_BREAK;
goto abnormalReturn;
}
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;
default:
panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
}
pc = (codePtr->codeStart + rangePtr->breakOffset);
continue;
case INST_CONTINUE:
Tcl_ResetResult(interp);
rangePtr = TclGetExceptionRangeForPc(pc, 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;
default:
panic("TclExecuteByteCode: unrecognized ExceptionRange type %d\n", rangePtr->type);
}
pc = (codePtr->codeStart + rangePtr->continueOffset);
continue;
case INST_FOREACH_START4:
opnd = TclGetUInt4AtPtr(pc+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);
{
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;
iterVarPtr = &(compiledLocals[iterTmpIndex]);
oldValuePtr = iterVarPtr->value.objPtr;
iterNum = (oldValuePtr->internalRep.longValue + 1);
Tcl_SetLongObj(oldValuePtr, iterNum);
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 (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, 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);
}
result = TCL_ERROR;
goto checkForCatch;
}
valIndex++;
}
listTmpIndex++;
}
}
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:
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);
}
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;
checkForCatch:
if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
RecordTracebackInfo(interp, pc, codePtr);
}
rangePtr = TclGetExceptionRangeForPc(pc, 1, codePtr);
if (rangePtr == NULL) {
TRACE((" ... no enclosing catch, returning %s\n",
StringForResultCode(result)));
goto abnormalReturn;
}
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;
}
abnormalReturn:
while (stackTop > initStackTop) {
valuePtr = POP_OBJECT();
Tcl_DecrRefCount(valuePtr);
}
done:
if (catchStackPtr != catchStackStorage) {
ckfree((char *) catchStackPtr);
}
eePtr->stackTop = initStackTop;
return result;
#undef STATIC_CATCH_STACK_SIZE
}
static void
PrintByteCodeInfo(codePtr)
register ByteCode *codePtr;
{
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);
}
}
#ifdef TCL_COMPILE_DEBUG
static void
ValidatePcAndStackTop(codePtr, pc, stackTop, stackLowerBound, stackUpperBound)
register ByteCode *codePtr;
unsigned char *pc;
int stackTop;
int stackLowerBound;
int stackUpperBound;
{
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
static void
IllegalExprOperandType(interp, opCode, opndPtr)
Tcl_Interp *interp;
unsigned int opCode;
Tcl_Obj *opndPtr;
{
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);
}
}
static void
CallTraceProcedure(interp, tracePtr, cmdPtr, command, numChars, objc, objv)
Tcl_Interp *interp;
register Trace *tracePtr;
Command *cmdPtr;
char *command;
int numChars;
register int objc;
Tcl_Obj *objv[];
{
Interp *iPtr = (Interp *) interp;
register char **argv;
register int i;
int length;
char *p;
argv = (char **) ckalloc((unsigned)(objc + 1) * sizeof(char *));
for (i = 0; i < objc; i++) {
argv[i] = Tcl_GetStringFromObj(objv[i], &length);
}
argv[objc] = 0;
p = (char *) ckalloc((unsigned) (numChars + 1));
memcpy((VOID *) p, (VOID *) command, (size_t) numChars);
p[numChars] = '\0';
(*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels,
p, cmdPtr->proc, cmdPtr->clientData, objc, argv);
ckfree((char *) argv);
ckfree((char *) p);
}
static void
RecordTracebackInfo(interp, pc, codePtr)
Tcl_Interp *interp;
unsigned char *pc;
ByteCode *codePtr;
{
register Interp *iPtr = (Interp *) interp;
char *cmd, *ellipsis;
char buf[200];
register char *p;
int numChars;
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;
}
}
static char *
GetSrcInfoForPc(pc, codePtr, lengthPtr)
unsigned char *pc;
ByteCode *codePtr;
int *lengthPtr;
{
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;
int bestSrcOffset = -1;
int bestSrcLength = -1;
if ((pcOffset < 0) || (pcOffset >= codePtr->numCodeBytes)) {
return NULL;
}
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) {
break;
} else if (pcOffset <= codeEnd) {
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);
}
ExceptionRange *
TclGetExceptionRangeForPc(pc, catchOnly, codePtr)
unsigned char *pc;
int catchOnly;
ByteCode* codePtr;
{
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;
}
static int
ExprUnaryFunc(interp, eePtr, clientData)
Tcl_Interp *interp;
ExecEnv *eePtr;
ClientData clientData;
{
StackItem *stackPtr;
register int stackTop;
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;
CACHE_STACK_INFO();
valuePtr = POP_OBJECT();
tPtr = valuePtr->typePtr;
if (tPtr == &tclIntType) {
d = (double) valuePtr->internalRep.longValue;
} else if (tPtr == &tclDoubleType) {
d = valuePtr->internalRep.doubleValue;
} else {
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_OBJECT(Tcl_NewDoubleObj(dResult));
done:
Tcl_DecrRefCount(valuePtr);
DECACHE_STACK_INFO();
return result;
}
static int
ExprBinaryFunc(interp, eePtr, clientData)
Tcl_Interp *interp;
ExecEnv *eePtr;
ClientData clientData;
{
StackItem *stackPtr;
register int stackTop;
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;
CACHE_STACK_INFO();
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 {
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 {
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_OBJECT(Tcl_NewDoubleObj(dResult));
done:
Tcl_DecrRefCount(valuePtr);
Tcl_DecrRefCount(value2Ptr);
DECACHE_STACK_INFO();
return result;
}
static int
ExprAbsFunc(interp, eePtr, clientData)
Tcl_Interp *interp;
ExecEnv *eePtr;
ClientData clientData;
{
StackItem *stackPtr;
register int stackTop;
register Tcl_Obj *valuePtr;
Tcl_ObjType *tPtr;
long i, iResult;
double d, dResult;
int result = TCL_OK;
CACHE_STACK_INFO();
valuePtr = POP_OBJECT();
tPtr = valuePtr->typePtr;
if (tPtr == &tclIntType) {
i = valuePtr->internalRep.longValue;
} else if (tPtr == &tclDoubleType) {
d = valuePtr->internalRep.doubleValue;
} else {
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;
}
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));
}
done:
Tcl_DecrRefCount(valuePtr);
DECACHE_STACK_INFO();
return result;
}
static int
ExprDoubleFunc(interp, eePtr, clientData)
Tcl_Interp *interp;
ExecEnv *eePtr;
ClientData clientData;
{
StackItem *stackPtr;
register int stackTop;
register Tcl_Obj *valuePtr;
double dResult;
long i;
int result = TCL_OK;
CACHE_STACK_INFO();
valuePtr = POP_OBJECT();
if (valuePtr->typePtr == &tclIntType) {
dResult = (double) valuePtr->internalRep.longValue;
} else if (valuePtr->typePtr == &tclDoubleType) {
dResult = valuePtr->internalRep.doubleValue;
} else {
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_OBJECT(Tcl_NewDoubleObj(dResult));
done:
Tcl_DecrRefCount(valuePtr);
DECACHE_STACK_INFO();
return result;
}
static int
ExprIntFunc(interp, eePtr, clientData)
Tcl_Interp *interp;
ExecEnv *eePtr;
ClientData clientData;
{
StackItem *stackPtr;
register int stackTop;
register Tcl_Obj *valuePtr;
Tcl_ObjType *tPtr;
long i = 0;
long iResult;
double d;
int result = TCL_OK;
CACHE_STACK_INFO();
valuePtr = POP_OBJECT();
tPtr = valuePtr->typePtr;
if (tPtr == &tclIntType) {
i = valuePtr->internalRep.longValue;
} else if (tPtr == &tclDoubleType) {
d = valuePtr->internalRep.doubleValue;
} else {
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;
}
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));
done:
Tcl_DecrRefCount(valuePtr);
DECACHE_STACK_INFO();
return result;
}
static int
ExprRandFunc(interp, eePtr, clientData)
Tcl_Interp *interp;
ExecEnv *eePtr;
ClientData clientData;
{
StackItem *stackPtr;
register int stackTop;
Interp *iPtr = (Interp *) interp;
double dResult;
int tmp;
if (!(iPtr->flags & RAND_SEED_INITIALIZED)) {
iPtr->flags |= RAND_SEED_INITIALIZED;
iPtr->randSeed = TclpGetClicks();
}
CACHE_STACK_INFO();
#define RAND_IA 16807
#define RAND_IM 2147483647
#define RAND_IQ 127773
#define RAND_IR 2836
#define RAND_MASK 123459876
if (iPtr->randSeed == 0) {
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;
}
iPtr->randSeed &= ((((unsigned long) 0xfffffff) << 4) | 0xf);
dResult = iPtr->randSeed * (1.0/RAND_IM);
PUSH_OBJECT(Tcl_NewDoubleObj(dResult));
DECACHE_STACK_INFO();
return TCL_OK;
}
static int
ExprRoundFunc(interp, eePtr, clientData)
Tcl_Interp *interp;
ExecEnv *eePtr;
ClientData clientData;
{
StackItem *stackPtr;
register int stackTop;
Tcl_Obj *valuePtr;
Tcl_ObjType *tPtr;
long i = 0;
long iResult;
double d, temp;
int result = TCL_OK;
CACHE_STACK_INFO();
valuePtr = POP_OBJECT();
tPtr = valuePtr->typePtr;
if (tPtr == &tclIntType) {
i = valuePtr->internalRep.longValue;
} else if (tPtr == &tclDoubleType) {
d = valuePtr->internalRep.doubleValue;
} else {
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;
}
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));
done:
Tcl_DecrRefCount(valuePtr);
DECACHE_STACK_INFO();
return result;
}
static int
ExprSrandFunc(interp, eePtr, clientData)
Tcl_Interp *interp;
ExecEnv *eePtr;
ClientData clientData;
{
StackItem *stackPtr;
register int stackTop;
Interp *iPtr = (Interp *) interp;
Tcl_Obj *valuePtr;
Tcl_ObjType *tPtr;
long i = 0;
int result;
CACHE_STACK_INFO();
valuePtr = POP_OBJECT();
tPtr = valuePtr->typePtr;
if (tPtr == &tclIntType) {
i = valuePtr->internalRep.longValue;
} else {
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;
}
}
iPtr->flags |= RAND_SEED_INITIALIZED;
iPtr->randSeed = i;
Tcl_DecrRefCount(valuePtr);
DECACHE_STACK_INFO();
ExprRandFunc(interp, eePtr, clientData);
return TCL_OK;
}
static int
ExprCallMathFunc(interp, eePtr, objc, objv)
Tcl_Interp *interp;
ExecEnv *eePtr;
int objc;
Tcl_Obj **objv;
{
Interp *iPtr = (Interp *) interp;
StackItem *stackPtr;
register int stackTop;
char *funcName;
Tcl_HashEntry *hPtr;
MathFunc *mathFuncPtr;
Tcl_Value args[MAX_MATH_ARGS];
Tcl_Value funcResult;
register Tcl_Obj *valuePtr;
Tcl_ObjType *tPtr;
long i;
double d;
int j, k, result;
Tcl_ResetResult(interp);
CACHE_STACK_INFO();
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;
}
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 {
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;
}
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;
}
}
}
tcl_MathInProgress++;
result = (*mathFuncPtr->proc)(mathFuncPtr->clientData, interp, args,
&funcResult);
tcl_MathInProgress--;
if (result != TCL_OK) {
goto done;
}
i = (stackTop - (objc-1));
while (i <= stackTop) {
valuePtr = stackPtr[i].o;
Tcl_DecrRefCount(valuePtr);
i++;
}
stackTop -= objc;
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));
}
done:
DECACHE_STACK_INFO();
return result;
}
void
TclExprFloatError(interp, value)
Tcl_Interp *interp;
double value;
{
char *s;
Tcl_ResetResult(interp);
if ((errno == EDOM) || (value != value)) {
s = "domain error: argument not in valid range";
Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, (char *) NULL);
} else if ((errno == ERANGE) || IS_INF(value)) {
if (value == 0.0) {
s = "floating-point value too small to represent";
Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, (char *) NULL);
} else {
s = "floating-point value too large to represent";
Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (char *) NULL);
}
} else {
char msg[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
int
TclLog2(value)
register int value;
{
register int n = value;
register int result = 0;
while (n > 1) {
n = n >> 1;
result++;
}
return result;
}
static int
EvalStatsCmd(unused, interp, argc, argv)
ClientData unused;
Tcl_Interp *interp;
int argc;
char **argv;
{
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
return TCL_OK;
}
#endif
Tcl_Command
Tcl_GetCommandFromObj(interp, objPtr)
Tcl_Interp *interp;
register Tcl_Obj *objPtr;
{
Interp *iPtr = (Interp *) interp;
register ResolvedCmdName *resPtr;
register Command *cmdPtr;
Namespace *currNsPtr;
int result;
if (objPtr->typePtr != &tclCmdNameType) {
result = tclCmdNameType.setFromAnyProc(interp, objPtr);
if (result != TCL_OK) {
return (Tcl_Command) NULL;
}
}
resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
if (iPtr->varFramePtr != NULL) {
currNsPtr = iPtr->varFramePtr->nsPtr;
} else {
currNsPtr = iPtr->globalNsPtr;
}
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;
}
static void
FreeCmdNameInternalRep(objPtr)
register Tcl_Obj *objPtr;
{
register ResolvedCmdName *resPtr =
(ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
if (resPtr != NULL) {
resPtr->refCount--;
if (resPtr->refCount == 0) {
Command *cmdPtr = resPtr->cmdPtr;
TclCleanupCommand(cmdPtr);
ckfree((char *) resPtr);
}
}
}
static void
DupCmdNameInternalRep(srcPtr, copyPtr)
Tcl_Obj *srcPtr;
register Tcl_Obj *copyPtr;
{
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;
}
static int
SetCmdNameFromAny(interp, objPtr)
Tcl_Interp *interp;
register Tcl_Obj *objPtr;
{
Interp *iPtr = (Interp *) interp;
char *name;
Tcl_Command cmd;
register Command *cmdPtr;
Namespace *currNsPtr;
register ResolvedCmdName *resPtr;
name = objPtr->bytes;
if (name == NULL) {
name = Tcl_GetStringFromObj(objPtr, (int *) NULL);
}
cmd = Tcl_FindCommand(interp, name, (Tcl_Namespace *) NULL,
0);
cmdPtr = (Command *) cmd;
if (cmdPtr != NULL) {
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;
}
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;
}
static void
UpdateStringOfCmdName(objPtr)
Tcl_Obj *objPtr;
{
panic("UpdateStringOfCmdName should never be invoked");
}
#ifdef TCL_COMPILE_DEBUG
static char *
StringForResultCode(result)
int result;
{
static char buf[20];
if ((result >= TCL_OK) && (result <= TCL_CONTINUE)) {
return resultStrings[result];
}
TclFormatInt(buf, result);
return buf;
}
#endif