summaryrefslogtreecommitdiffstats
path: root/generic/tclExecute.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r--generic/tclExecute.c822
1 files changed, 214 insertions, 608 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 0279218..197b1e9 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -73,11 +73,11 @@ int tclTraceExec = 0;
* expression opcodes (e.g., INST_LOR) in tclCompile.h.
*
* Does not include the string for INST_EXPON (and beyond), as that is
- * disjoint for backward-compatability reasons.
+ * disjoint for backward-compatibility reasons.
*/
static const char *const operatorStrings[] = {
- "||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
+ "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
"+", "-", "*", "/", "%", "+", "-", "~", "!"
};
@@ -101,64 +101,6 @@ size_t tclObjsAlloced = 0;
size_t tclObjsFreed = 0;
size_t tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
#endif /* TCL_COMPILE_STATS */
-
-/*
- * Support pre-8.5 bytecodes unless specifically requested otherwise.
- */
-
-#ifndef TCL_SUPPORT_84_BYTECODE
-#define TCL_SUPPORT_84_BYTECODE 1
-#endif
-
-#if TCL_SUPPORT_84_BYTECODE
-/*
- * We need to know the tclBuiltinFuncTable to support translation of pre-8.5
- * math functions to the namespace-based ::tcl::mathfunc::op in 8.5+.
- */
-
-typedef struct {
- const char *name; /* Name of function. */
- int numArgs; /* Number of arguments for function. */
-} BuiltinFunc;
-
-/*
- * 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.
- */
-
-static BuiltinFunc const tclBuiltinFuncTable[] = {
- {"acos", 1},
- {"asin", 1},
- {"atan", 1},
- {"atan2", 2},
- {"ceil", 1},
- {"cos", 1},
- {"cosh", 1},
- {"exp", 1},
- {"floor", 1},
- {"fmod", 2},
- {"hypot", 2},
- {"log", 1},
- {"log10", 1},
- {"pow", 2},
- {"sin", 1},
- {"sinh", 1},
- {"sqrt", 1},
- {"tan", 1},
- {"tanh", 1},
- {"abs", 1},
- {"double", 1},
- {"int", 1},
- {"rand", 0},
- {"round", 1},
- {"srand", 1},
- {"wide", 1},
- {NULL, 0},
-};
-
-#define LAST_BUILTIN_FUNC 25
-#endif
/*
* NR_TEBC
@@ -166,7 +108,7 @@ static BuiltinFunc const tclBuiltinFuncTable[] = {
* Minimal data required to fully reconstruct the execution state.
*/
-typedef struct TEBCdata {
+typedef struct {
ByteCode *codePtr; /* Constant until the BC returns */
/* -----------------------------------------*/
ptrdiff_t *catchTop; /* These fields are used on return TO this */
@@ -437,9 +379,9 @@ VarHashCreateVar(
#ifdef TCL_COMPILE_DEBUG
# define TRACE(a) \
while (traceInstructions) { \
- fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \
+ fprintf(stdout, "%2d: %2d (%" TCL_Z_MODIFIER "u) %s ", iPtr->numLevels, \
(int) CURR_DEPTH, \
- (unsigned) (pc - codePtr->codeStart), \
+ (size_t) (pc - codePtr->codeStart), \
GetOpcodeName(pc)); \
printf a; \
break; \
@@ -453,9 +395,9 @@ VarHashCreateVar(
TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
# define TRACE_WITH_OBJ(a, objPtr) \
while (traceInstructions) { \
- fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \
+ fprintf(stdout, "%2d: %2d (%" TCL_Z_MODIFIER "u) %s ", iPtr->numLevels, \
(int) CURR_DEPTH, \
- (unsigned) (pc - codePtr->codeStart), \
+ (size_t) (pc - codePtr->codeStart), \
GetOpcodeName(pc)); \
printf a; \
TclPrintObject(stdout, objPtr, 30); \
@@ -511,13 +453,13 @@ VarHashCreateVar(
#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
((TclHasInternalRep((objPtr), &tclIntType)) \
? (*(tPtr) = TCL_NUMBER_INT, \
- *(ptrPtr) = (ClientData) \
+ *(ptrPtr) = (void *) \
(&((objPtr)->internalRep.wideValue)), TCL_OK) : \
TclHasInternalRep((objPtr), &tclDoubleType) \
? (((isnan((objPtr)->internalRep.doubleValue)) \
? (*(tPtr) = TCL_NUMBER_NAN) \
: (*(tPtr) = TCL_NUMBER_DOUBLE)), \
- *(ptrPtr) = (ClientData) \
+ *(ptrPtr) = (void *) \
(&((objPtr)->internalRep.doubleValue)), TCL_OK) : \
(((objPtr)->bytes != NULL) && ((objPtr)->length == 0)) \
? TCL_ERROR : \
@@ -694,7 +636,7 @@ static void FreeExprCodeInternalRep(Tcl_Obj *objPtr);
static ExceptionRange * GetExceptRangeForPc(const unsigned char *pc,
int searchMode, ByteCode *codePtr);
static const char * GetSrcInfoForPc(const unsigned char *pc,
- ByteCode *codePtr, int *lengthPtr,
+ ByteCode *codePtr, size_t *lengthPtr,
const unsigned char **pcBeg, int *cmdIdxPtr);
static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, int growth,
int move);
@@ -704,8 +646,8 @@ static void InitByteCodeExecution(Tcl_Interp *interp);
static inline int wordSkip(void *ptr);
static void ReleaseDictIterator(Tcl_Obj *objPtr);
/* Useful elsewhere, make available in tclInt.h or stubs? */
-static Tcl_Obj ** StackAllocWords(Tcl_Interp *interp, int numWords);
-static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, int numWords);
+static Tcl_Obj ** StackAllocWords(Tcl_Interp *interp, size_t numWords);
+static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, size_t numWords);
static Tcl_NRPostProc CopyCallback;
static Tcl_NRPostProc ExprObjCallback;
static Tcl_NRPostProc FinalizeOONext;
@@ -771,7 +713,7 @@ ReleaseDictIterator(
searchPtr = (Tcl_DictSearch *)irPtr->twoPtrValue.ptr1;
Tcl_DictObjDone(searchPtr);
- ckfree(searchPtr);
+ Tcl_Free(searchPtr);
dictPtr = (Tcl_Obj *)irPtr->twoPtrValue.ptr2;
TclDecrRefCount(dictPtr);
@@ -851,11 +793,11 @@ ExecEnv *
TclCreateExecEnv(
Tcl_Interp *interp, /* Interpreter for which the execution
* environment is being created. */
- int size) /* The initial stack size, in number of words
+ size_t size) /* The initial stack size, in number of words
* [sizeof(Tcl_Obj*)] */
{
- ExecEnv *eePtr = (ExecEnv *)ckalloc(sizeof(ExecEnv));
- ExecStack *esPtr = (ExecStack *)ckalloc(offsetof(ExecStack, stackWords)
+ ExecEnv *eePtr = (ExecEnv *)Tcl_Alloc(sizeof(ExecEnv));
+ ExecStack *esPtr = (ExecStack *)Tcl_Alloc(offsetof(ExecStack, stackWords)
+ size * sizeof(Tcl_Obj *));
eePtr->execStackPtr = esPtr;
@@ -915,7 +857,7 @@ DeleteExecStack(
if (esPtr->nextPtr) {
esPtr->nextPtr->prevPtr = esPtr->prevPtr;
}
- ckfree(esPtr);
+ Tcl_Free(esPtr);
}
void
@@ -947,7 +889,7 @@ TclDeleteExecEnv(
if (eePtr->corPtr && !cachedInExit) {
Tcl_Panic("Deleting execEnv with existing coroutine");
}
- ckfree(eePtr);
+ Tcl_Free(eePtr);
}
/*
@@ -1038,8 +980,8 @@ GrowEvaluationStack(
int move) /* 1 if move words since last marker. */
{
ExecStack *esPtr = eePtr->execStackPtr, *oldPtr = NULL;
- int newBytes, newElems, currElems;
- int needed = growth - (esPtr->endPtr - esPtr->tosPtr);
+ size_t newBytes;
+ int newElems, currElems, needed = growth - (esPtr->endPtr - esPtr->tosPtr);
Tcl_Obj **markerPtr = esPtr->markerPtr, **memStart;
int moveWords = 0;
@@ -1124,7 +1066,7 @@ GrowEvaluationStack(
newBytes = offsetof(ExecStack, stackWords) + newElems * sizeof(Tcl_Obj *);
oldPtr = esPtr;
- esPtr = (ExecStack *)ckalloc(newBytes);
+ esPtr = (ExecStack *)Tcl_Alloc(newBytes);
oldPtr->nextPtr = esPtr;
esPtr->prevPtr = oldPtr;
@@ -1184,7 +1126,7 @@ GrowEvaluationStack(
static Tcl_Obj **
StackAllocWords(
Tcl_Interp *interp,
- int numWords)
+ size_t numWords)
{
/*
* Note that GrowEvaluationStack sets a marker in the stack. This marker
@@ -1202,7 +1144,7 @@ StackAllocWords(
static Tcl_Obj **
StackReallocWords(
Tcl_Interp *interp,
- int numWords)
+ size_t numWords)
{
Interp *iPtr = (Interp *) interp;
ExecEnv *eePtr = iPtr->execEnvPtr;
@@ -1223,7 +1165,7 @@ TclStackFree(
Tcl_Obj **markerPtr, *marker;
if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
- ckfree(freePtr);
+ Tcl_Free(freePtr);
return;
}
@@ -1281,32 +1223,32 @@ TclStackFree(
void *
TclStackAlloc(
Tcl_Interp *interp,
- int numBytes)
+ size_t numBytes)
{
Interp *iPtr = (Interp *) interp;
- int numWords;
+ size_t numWords;
if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
- return (void *) ckalloc(numBytes);
+ return (void *) Tcl_Alloc(numBytes);
}
numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
- return (void *) StackAllocWords(interp, numWords);
+ return StackAllocWords(interp, numWords);
}
void *
TclStackRealloc(
Tcl_Interp *interp,
void *ptr,
- int numBytes)
+ size_t numBytes)
{
Interp *iPtr = (Interp *) interp;
ExecEnv *eePtr;
ExecStack *esPtr;
Tcl_Obj **markerPtr;
- int numWords;
+ size_t numWords;
if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
- return (void *) ckrealloc((char *) ptr, numBytes);
+ return Tcl_Realloc(ptr, numBytes);
}
eePtr = iPtr->execEnvPtr;
@@ -1348,7 +1290,7 @@ int
Tcl_ExprObj(
Tcl_Interp *interp, /* Context in which to evaluate the
* expression. */
- Tcl_Obj *objPtr, /* Points to Tcl object containing expression
+ Tcl_Obj *objPtr, /* Points to Tcl object containing expression
* to evaluate. */
Tcl_Obj **resultPtrPtr) /* Where the Tcl_Obj* that is the expression
* result is stored if no errors occur. */
@@ -1494,10 +1436,11 @@ CompileExprObj(
* TIP #280: No invoker (yet) - Expression compilation.
*/
- const char *string = TclGetString(objPtr);
+ size_t length;
+ const char *string = Tcl_GetStringFromObj(objPtr, &length);
- TclInitCompileEnv(interp, &compEnv, string, objPtr->length, NULL, 0);
- TclCompileExpr(interp, string, objPtr->length, &compEnv, 0);
+ TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0);
+ TclCompileExpr(interp, string, length, &compEnv, 0);
/*
* Successful compilation. If the expression yielded no instructions,
@@ -2446,8 +2389,8 @@ TEBCresume(
if (traceInstructions) {
TRACE_APPEND(("YIELD...\n"));
} else {
- fprintf(stdout, "%d: (%u) yielding value \"%.30s\"\n",
- iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
+ fprintf(stdout, "%d: (%" TCL_Z_MODIFIER "u) yielding value \"%.30s\"\n",
+ iPtr->numLevels, (size_t)(pc - codePtr->codeStart),
Tcl_GetString(OBJ_AT_TOS));
}
fflush(stdout);
@@ -2489,8 +2432,8 @@ TEBCresume(
TRACE(("[%.30s] => YIELD...\n", O2S(valuePtr)));
} else {
/* FIXME: What is the right thing to trace? */
- fprintf(stdout, "%d: (%u) yielding to [%.30s]\n",
- iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
+ fprintf(stdout, "%d: (%" TCL_Z_MODIFIER "u) yielding to [%.30s]\n",
+ iPtr->numLevels, (size_t)(pc - codePtr->codeStart),
TclGetString(valuePtr));
}
fflush(stdout);
@@ -2685,7 +2628,7 @@ TEBCresume(
* command starts.
*
* Use a Tcl_Obj as linked list element; slight mem waste, but faster
- * allocation than ckalloc. This also abuses the Tcl_Obj structure, as
+ * allocation than Tcl_Alloc. This also abuses the Tcl_Obj structure, as
* we do not define a special tclObjType for it. It is not dangerous
* as the obj is never passed anywhere, so that all manipulations are
* performed here and in INST_INVOKE_EXPANDED (in case of an expansion
@@ -2806,7 +2749,7 @@ TEBCresume(
pc += 1;
/* yield next instruction */
TEBC_YIELD();
- /* add TEBCResume for object at top of stack */
+ /* add TEBCresume for object at top of stack */
return TclNRExecuteByteCode(interp,
TclCompileObj(interp, OBJ_AT_TOS, NULL, 0));
@@ -2848,8 +2791,8 @@ TEBCresume(
strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
TRACE(("%u => call ", objc));
} else {
- fprintf(stdout, "%d: (%u) invoking ", iPtr->numLevels,
- (unsigned)(pc - codePtr->codeStart));
+ fprintf(stdout, "%d: (%" TCL_Z_MODIFIER "u) invoking ", iPtr->numLevels,
+ (size_t)(pc - codePtr->codeStart));
}
for (i = 0; i < objc; i++) {
TclPrintObject(stdout, objv[i], 15);
@@ -2881,91 +2824,6 @@ TEBCresume(
return TclNREvalObjv(interp, objc, objv,
TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL);
-#if TCL_SUPPORT_84_BYTECODE
- case INST_CALL_BUILTIN_FUNC1:
- /*
- * Call one of the built-in pre-8.5 Tcl math functions. This
- * translates to INST_INVOKE_STK1 with the first argument of
- * ::tcl::mathfunc::$objv[0]. We need to insert the named math
- * function into the stack.
- */
-
- opnd = TclGetUInt1AtPtr(pc+1);
- if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
- TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
- Tcl_Panic("TclNRExecuteByteCode: unrecognized builtin function code %d", opnd);
- }
-
- TclNewLiteralStringObj(objPtr, "::tcl::mathfunc::");
- Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1);
-
- /*
- * Only 0, 1 or 2 args.
- */
-
- {
- int numArgs = tclBuiltinFuncTable[opnd].numArgs;
- Tcl_Obj *tmpPtr1, *tmpPtr2;
-
- if (numArgs == 0) {
- PUSH_OBJECT(objPtr);
- } else if (numArgs == 1) {
- tmpPtr1 = POP_OBJECT();
- PUSH_OBJECT(objPtr);
- PUSH_OBJECT(tmpPtr1);
- Tcl_DecrRefCount(tmpPtr1);
- } else {
- tmpPtr2 = POP_OBJECT();
- tmpPtr1 = POP_OBJECT();
- PUSH_OBJECT(objPtr);
- PUSH_OBJECT(tmpPtr1);
- PUSH_OBJECT(tmpPtr2);
- Tcl_DecrRefCount(tmpPtr1);
- Tcl_DecrRefCount(tmpPtr2);
- }
- objc = numArgs + 1;
- }
- pcAdjustment = 2;
- goto doInvocation;
-
- case INST_CALL_FUNC1:
- /*
- * Call a non-builtin Tcl math function previously registered by a
- * call to Tcl_CreateMathFunc pre-8.5. This is essentially
- * INST_INVOKE_STK1 converting the first arg to
- * ::tcl::mathfunc::$objv[0].
- */
-
- objc = TclGetUInt1AtPtr(pc+1); /* Number of arguments. The function
- * name is the 0-th argument. */
-
- objPtr = OBJ_AT_DEPTH(objc-1);
- TclNewLiteralStringObj(tmpPtr, "::tcl::mathfunc::");
- Tcl_AppendObjToObj(tmpPtr, objPtr);
- Tcl_DecrRefCount(objPtr);
-
- /*
- * Variation of PUSH_OBJECT.
- */
-
- OBJ_AT_DEPTH(objc-1) = tmpPtr;
- Tcl_IncrRefCount(tmpPtr);
-
- pcAdjustment = 2;
- goto doInvocation;
-#else
- /*
- * INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the
- * changes to add a ::tcl::mathfunc namespace in 8.5. Optional support
- * remains for existing bytecode precompiled files.
- */
-
- case INST_CALL_BUILTIN_FUNC1:
- Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found");
- case INST_CALL_FUNC1:
- Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found");
-#endif
-
case INST_INVOKE_REPLACE:
objc = TclGetUInt4AtPtr(pc+1);
opnd = TclGetUInt1AtPtr(pc+5);
@@ -2981,8 +2839,8 @@ TEBCresume(
TRACE(("%u => call (implementation %s) ", objc, O2S(objPtr)));
} else {
fprintf(stdout,
- "%d: (%u) invoking (using implementation %s) ",
- iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
+ "%d: (%" TCL_Z_MODIFIER "u) invoking (using implementation %s) ",
+ iPtr->numLevels, (size_t)(pc - codePtr->codeStart),
O2S(objPtr));
}
for (i = 0; i < objc; i++) {
@@ -3786,7 +3644,7 @@ TEBCresume(
arrayPtr = NULL;
part1Ptr = part2Ptr = NULL;
cleanup = 0;
- TRACE(("%u %s => ", opnd, Tcl_GetString(incrPtr)));
+ TRACE(("%u %s => ", opnd, TclGetString(incrPtr)));
doIncrVar:
if (TclIsVarDirectModifyable2(varPtr, arrayPtr)) {
@@ -4053,29 +3911,6 @@ TEBCresume(
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
-
- /*
- * This is really an unset operation these days. Do not issue.
- */
-
- case INST_DICT_DONE:
- opnd = TclGetUInt4AtPtr(pc+1);
- TRACE(("%u => OK\n", opnd));
- varPtr = LOCAL(opnd);
- while (TclIsVarLink(varPtr)) {
- varPtr = varPtr->value.linkPtr;
- }
- if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
- if (!TclIsVarUndefined(varPtr)) {
- TclDecrRefCount(varPtr->value.objPtr);
- }
- varPtr->value.objPtr = NULL;
- } else {
- DECACHE_STACK_INFO();
- TclPtrUnsetVarIdx(interp, varPtr, NULL, NULL, NULL, 0, opnd);
- CACHE_STACK_INFO();
- }
- NEXT_INST_F(5, 0, 0);
}
break;
@@ -4304,15 +4139,15 @@ TEBCresume(
case INST_JUMP1:
opnd = TclGetInt1AtPtr(pc+1);
- TRACE(("%d => new pc %u\n", opnd,
- (unsigned)(pc + opnd - codePtr->codeStart)));
+ TRACE(("%d => new pc %" TCL_Z_MODIFIER "u\n", opnd,
+ (size_t)(pc + opnd - codePtr->codeStart)));
NEXT_INST_F(opnd, 0, 0);
break;
case INST_JUMP4:
opnd = TclGetInt4AtPtr(pc+1);
- TRACE(("%d => new pc %u\n", opnd,
- (unsigned)(pc + opnd - codePtr->codeStart)));
+ TRACE(("%d => new pc %" TCL_Z_MODIFIER "u\n", opnd,
+ (size_t)(pc + opnd - codePtr->codeStart)));
NEXT_INST_F(opnd, 0, 0);
{
@@ -4354,8 +4189,8 @@ TEBCresume(
#ifdef TCL_COMPILE_DEBUG
if (b) {
if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
- TRACE_APPEND(("%.20s true, new pc %u\n", O2S(valuePtr),
- (unsigned)(pc + jmpOffset[1] - codePtr->codeStart)));
+ TRACE_APPEND(("%.20s true, new pc %" TCL_Z_MODIFIER "u\n", O2S(valuePtr),
+ (size_t)(pc + jmpOffset[1] - codePtr->codeStart)));
} else {
TRACE_APPEND(("%.20s true\n", O2S(valuePtr)));
}
@@ -4363,8 +4198,8 @@ TEBCresume(
if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
TRACE_APPEND(("%.20s false\n", O2S(valuePtr)));
} else {
- TRACE_APPEND(("%.20s false, new pc %u\n", O2S(valuePtr),
- (unsigned)(pc + jmpOffset[0] - codePtr->codeStart)));
+ TRACE_APPEND(("%.20s false, new pc %" TCL_Z_MODIFIER "u\n", O2S(valuePtr),
+ (size_t)(pc + jmpOffset[0] - codePtr->codeStart)));
}
}
#endif
@@ -4388,8 +4223,8 @@ TEBCresume(
if (hPtr != NULL) {
int jumpOffset = PTR2INT(Tcl_GetHashValue(hPtr));
- TRACE_APPEND(("found in table, new pc %u\n",
- (unsigned)(pc - codePtr->codeStart + jumpOffset)));
+ TRACE_APPEND(("found in table, new pc %" TCL_Z_MODIFIER "u\n",
+ (size_t)(pc - codePtr->codeStart + jumpOffset)));
NEXT_INST_F(jumpOffset, 1, 0);
} else {
TRACE_APPEND(("not found in table\n"));
@@ -4399,51 +4234,6 @@ TEBCresume(
break;
/*
- * These two instructions are now redundant: the complete logic of the LOR
- * and LAND is now handled by the expression compiler.
- */
-
- case INST_LOR:
- case INST_LAND: {
- /*
- * Operands must be boolean or numeric. No int->double conversions are
- * performed.
- */
-
- int i1, i2, iResult;
-
- value2Ptr = OBJ_AT_TOS;
- valuePtr = OBJ_UNDER_TOS;
- if (TclGetBooleanFromObj(NULL, valuePtr, &i1) != TCL_OK) {
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
- (valuePtr->typePtr? valuePtr->typePtr->name : "null")));
- DECACHE_STACK_INFO();
- IllegalExprOperandType(interp, pc, valuePtr);
- CACHE_STACK_INFO();
- goto gotError;
- }
-
- if (TclGetBooleanFromObj(NULL, value2Ptr, &i2) != TCL_OK) {
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr),
- (value2Ptr->typePtr? value2Ptr->typePtr->name : "null")));
- DECACHE_STACK_INFO();
- IllegalExprOperandType(interp, pc, value2Ptr);
- CACHE_STACK_INFO();
- goto gotError;
- }
-
- if (*pc == INST_LOR) {
- iResult = (i1 || i2);
- } else {
- iResult = (i1 && i2);
- }
- objResultPtr = TCONST(iResult);
- TRACE(("%.20s %.20s => %d\n", O2S(valuePtr),O2S(value2Ptr),iResult));
- NEXT_INST_F(1, 2, 1);
- }
- break;
-
- /*
* -----------------------------------------------------------------
* Start of general introspector instructions.
*/
@@ -4559,7 +4349,7 @@ TEBCresume(
Object *oPtr;
CallFrame *framePtr;
CallContext *contextPtr;
- int skip, newDepth;
+ size_t skip, newDepth;
case INST_TCLOO_SELF:
framePtr = iPtr->varFramePtr;
@@ -4611,7 +4401,7 @@ TEBCresume(
} else {
Class *classPtr = oPtr->classPtr;
struct MInvoke *miPtr;
- int i;
+ size_t i;
const char *methodType;
if (classPtr == NULL) {
@@ -4634,11 +4424,11 @@ TEBCresume(
if (traceInstructions) {
strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
} else {
- fprintf(stdout, "%d: (%u) invoking ",
+ fprintf(stdout, "%d: (%" TCL_Z_MODIFIER "u) invoking ",
iPtr->numLevels,
- (unsigned)(pc - codePtr->codeStart));
+ (size_t)(pc - codePtr->codeStart));
}
- for (i = 0; i < opnd; i++) {
+ for (i = 0; i < (size_t)opnd; i++) {
TclPrintObject(stdout, objv[i], 15);
fprintf(stdout, " ");
}
@@ -4660,7 +4450,7 @@ TEBCresume(
TRACE_APPEND(("ERROR: \"%.30s\" not on reachable chain\n",
O2S(valuePtr)));
- for (i=contextPtr->index ; i>=0 ; i--) {
+ for (i=contextPtr->index ; i != TCL_INDEX_NONE ; i--) {
miPtr = contextPtr->callPtr->chain + i;
if (miPtr->isFilter
|| miPtr->mPtr->declaringClassPtr != classPtr) {
@@ -4736,8 +4526,8 @@ TEBCresume(
if (traceInstructions) {
strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
} else {
- fprintf(stdout, "%d: (%u) invoking ",
- iPtr->numLevels, (unsigned)(pc - codePtr->codeStart));
+ fprintf(stdout, "%d: (%" TCL_Z_MODIFIER "u) invoking ",
+ iPtr->numLevels, (size_t)(pc - codePtr->codeStart));
}
for (i = 0; i < opnd; i++) {
TclPrintObject(stdout, objv[i], 15);
@@ -4829,8 +4619,8 @@ TEBCresume(
*/
{
- int index, numIndices, fromIdx, toIdx;
- int nocase, match, length2, cflags, s1len, s2len;
+ int numIndices, nocase, match, cflags;
+ size_t slength, length2, fromIdx, toIdx, index, s1len, s2len;
const char *s1, *s2;
case INST_LIST:
@@ -4919,7 +4709,7 @@ TEBCresume(
pcAdjustment = 5;
lindexFastPath:
- if (index >= 0 && index < objc) {
+ if (index < (size_t)objc) {
objResultPtr = objv[index];
} else {
TclNewObj(objResultPtr);
@@ -5082,13 +4872,13 @@ TEBCresume(
NEXT_INST_F(9, 1, 1);
}
toIdx = TclIndexDecode(toIdx, objc - 1);
- if (toIdx < 0) {
+ if (toIdx == TCL_INDEX_NONE) {
goto emptyList;
- } else if (toIdx >= objc) {
+ } else if (toIdx + 1 >= (size_t)objc + 1) {
toIdx = objc - 1;
}
- assert ( toIdx >= 0 && toIdx < objc);
+ assert (toIdx < (size_t)objc);
/*
assert ( fromIdx != TCL_INDEX_NONE );
*
@@ -5110,7 +4900,7 @@ TEBCresume(
value2Ptr = OBJ_AT_TOS;
valuePtr = OBJ_UNDER_TOS;
- s1 = TclGetStringFromObj(valuePtr, &s1len);
+ s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) {
TRACE_ERROR(interp);
@@ -5128,7 +4918,7 @@ TEBCresume(
do {
Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
if (o != NULL) {
- s2 = TclGetStringFromObj(o, &s2len);
+ s2 = Tcl_GetStringFromObj(o, &s2len);
} else {
s2 = "";
s2len = 0;
@@ -5244,24 +5034,24 @@ TEBCresume(
case INST_STR_LEN:
valuePtr = OBJ_AT_TOS;
- length = Tcl_GetCharLength(valuePtr);
- TclNewIntObj(objResultPtr, length);
- TRACE(("\"%.20s\" => %d\n", O2S(valuePtr), length));
+ slength = Tcl_GetCharLength(valuePtr);
+ TclNewIntObj(objResultPtr, slength);
+ TRACE(("\"%.20s\" => %" TCL_Z_MODIFIER "u\n", O2S(valuePtr), slength));
NEXT_INST_F(1, 1, 1);
case INST_STR_UPPER:
valuePtr = OBJ_AT_TOS;
TRACE(("\"%.20s\" => ", O2S(valuePtr)));
if (Tcl_IsShared(valuePtr)) {
- s1 = TclGetStringFromObj(valuePtr, &length);
- TclNewStringObj(objResultPtr, s1, length);
- length = Tcl_UtfToUpper(TclGetString(objResultPtr));
- Tcl_SetObjLength(objResultPtr, length);
+ s1 = Tcl_GetStringFromObj(valuePtr, &slength);
+ TclNewStringObj(objResultPtr, s1, slength);
+ slength = Tcl_UtfToUpper(TclGetString(objResultPtr));
+ Tcl_SetObjLength(objResultPtr, slength);
TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
} else {
- length = Tcl_UtfToUpper(TclGetString(valuePtr));
- Tcl_SetObjLength(valuePtr, length);
+ slength = Tcl_UtfToUpper(TclGetString(valuePtr));
+ Tcl_SetObjLength(valuePtr, slength);
TclFreeInternalRep(valuePtr);
TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
@@ -5270,15 +5060,15 @@ TEBCresume(
valuePtr = OBJ_AT_TOS;
TRACE(("\"%.20s\" => ", O2S(valuePtr)));
if (Tcl_IsShared(valuePtr)) {
- s1 = TclGetStringFromObj(valuePtr, &length);
- TclNewStringObj(objResultPtr, s1, length);
- length = Tcl_UtfToLower(TclGetString(objResultPtr));
- Tcl_SetObjLength(objResultPtr, length);
+ s1 = Tcl_GetStringFromObj(valuePtr, &slength);
+ TclNewStringObj(objResultPtr, s1, slength);
+ slength = Tcl_UtfToLower(TclGetString(objResultPtr));
+ Tcl_SetObjLength(objResultPtr, slength);
TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
} else {
- length = Tcl_UtfToLower(TclGetString(valuePtr));
- Tcl_SetObjLength(valuePtr, length);
+ slength = Tcl_UtfToLower(TclGetString(valuePtr));
+ Tcl_SetObjLength(valuePtr, slength);
TclFreeInternalRep(valuePtr);
TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
@@ -5287,15 +5077,15 @@ TEBCresume(
valuePtr = OBJ_AT_TOS;
TRACE(("\"%.20s\" => ", O2S(valuePtr)));
if (Tcl_IsShared(valuePtr)) {
- s1 = TclGetStringFromObj(valuePtr, &length);
- TclNewStringObj(objResultPtr, s1, length);
- length = Tcl_UtfToTitle(TclGetString(objResultPtr));
- Tcl_SetObjLength(objResultPtr, length);
+ s1 = Tcl_GetStringFromObj(valuePtr, &slength);
+ TclNewStringObj(objResultPtr, s1, slength);
+ slength = Tcl_UtfToTitle(TclGetString(objResultPtr));
+ Tcl_SetObjLength(objResultPtr, slength);
TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
} else {
- length = Tcl_UtfToTitle(TclGetString(valuePtr));
- Tcl_SetObjLength(valuePtr, length);
+ slength = Tcl_UtfToTitle(TclGetString(valuePtr));
+ Tcl_SetObjLength(valuePtr, slength);
TclFreeInternalRep(valuePtr);
TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
@@ -5310,21 +5100,21 @@ TEBCresume(
* Get char length to calulate what 'end' means.
*/
- length = Tcl_GetCharLength(valuePtr);
+ slength = Tcl_GetCharLength(valuePtr);
DECACHE_STACK_INFO();
- if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
+ if (TclGetIntForIndexM(interp, value2Ptr, slength-1, &index)!=TCL_OK) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
CACHE_STACK_INFO();
- if ((index < 0) || (index >= length)) {
+ if (index >= slength) {
TclNewObj(objResultPtr);
} else if (TclIsPureByteArray(valuePtr)) {
objResultPtr = Tcl_NewByteArrayObj(
- TclGetByteArrayFromObj(valuePtr, NULL)+index, 1);
- } else if (valuePtr->bytes && length == valuePtr->length) {
+ (Tcl_GetBytesFromObj)(NULL, valuePtr, NULL)+index, 1);
+ } else if (valuePtr->bytes && slength == valuePtr->length) {
objResultPtr = Tcl_NewStringObj((const char *)
valuePtr->bytes+index, 1);
} else {
@@ -5339,11 +5129,11 @@ TEBCresume(
if (ch == -1) {
TclNewObj(objResultPtr);
} else {
- length = Tcl_UniCharToUtf(ch, buf);
- if ((ch >= 0xD800) && (length < 3)) {
- length += Tcl_UniCharToUtf(-1, buf + length);
+ slength = Tcl_UniCharToUtf(ch, buf);
+ if ((ch >= 0xD800) && (slength < 3)) {
+ slength += Tcl_UniCharToUtf(-1, buf + slength);
}
- objResultPtr = Tcl_NewStringObj(buf, length);
+ objResultPtr = Tcl_NewStringObj(buf, slength);
}
}
@@ -5353,16 +5143,16 @@ TEBCresume(
case INST_STR_RANGE:
TRACE(("\"%.20s\" %.20s %.20s =>",
O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS)));
- length = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1;
+ slength = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1;
DECACHE_STACK_INFO();
- if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
+ if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, slength,
&fromIdx) != TCL_OK) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
- if (TclGetIntForIndexM(interp, OBJ_AT_TOS, length,
+ if (TclGetIntForIndexM(interp, OBJ_AT_TOS, slength,
&toIdx) != TCL_OK) {
CACHE_STACK_INFO();
TRACE_ERROR(interp);
@@ -5370,7 +5160,7 @@ TEBCresume(
}
CACHE_STACK_INFO();
- if (toIdx < 0) {
+ if (toIdx == TCL_INDEX_NONE) {
TclNewObj(objResultPtr);
} else {
objResultPtr = Tcl_GetRange(OBJ_AT_DEPTH(2), fromIdx, toIdx);
@@ -5382,59 +5172,42 @@ TEBCresume(
valuePtr = OBJ_AT_TOS;
fromIdx = TclGetInt4AtPtr(pc+1);
toIdx = TclGetInt4AtPtr(pc+5);
- length = Tcl_GetCharLength(valuePtr);
- TRACE(("\"%.20s\" %d %d => ", O2S(valuePtr), fromIdx, toIdx));
+ slength = Tcl_GetCharLength(valuePtr);
+ TRACE(("\"%.20s\" %d %d => ", O2S(valuePtr), (int)(fromIdx), (int)(toIdx)));
/* Every range of an empty value is an empty value */
- if (length == 0) {
+ if (slength == 0) {
TRACE_APPEND(("\n"));
NEXT_INST_F(9, 0, 0);
}
/* Decode index operands. */
- /*
- assert ( toIdx != TCL_INDEX_NONE );
- *
- * Extra safety for legacy bytecodes:
- */
+ toIdx = TclIndexDecode(toIdx, slength - 1);
+ fromIdx = TclIndexDecode(fromIdx, slength - 1);
if (toIdx == TCL_INDEX_NONE) {
TclNewObj(objResultPtr);
} else {
- toIdx = TclIndexDecode(toIdx, length - 1);
- /*
- assert ( fromIdx != TCL_INDEX_NONE );
- *
- * Extra safety for legacy bytecodes:
- */
- if (fromIdx == TCL_INDEX_NONE) {
- fromIdx = TCL_INDEX_START;
- }
- fromIdx = TclIndexDecode(fromIdx, length - 1);
- if (toIdx < 0) {
- TclNewObj(objResultPtr);
- } else {
- objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
- }
+ objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
}
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
NEXT_INST_F(9, 1, 1);
{
Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p;
- int length3, endIdx;
+ size_t length3;
Tcl_Obj *value3Ptr;
case INST_STR_REPLACE:
value3Ptr = POP_OBJECT();
valuePtr = OBJ_AT_DEPTH(2);
- endIdx = Tcl_GetCharLength(valuePtr) - 1;
+ slength = Tcl_GetCharLength(valuePtr) - 1;
TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr),
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr)));
DECACHE_STACK_INFO();
- if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, endIdx,
+ if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, slength,
&fromIdx) != TCL_OK
- || TclGetIntForIndexM(interp, OBJ_AT_TOS, endIdx,
+ || TclGetIntForIndexM(interp, OBJ_AT_TOS, slength,
&toIdx) != TCL_OK) {
CACHE_STACK_INFO();
TclDecrRefCount(value3Ptr);
@@ -5447,23 +5220,23 @@ TEBCresume(
TclDecrRefCount(OBJ_AT_TOS);
(void) POP_OBJECT();
- if ((toIdx < 0) ||
- (fromIdx > endIdx) ||
- (toIdx < fromIdx)) {
+ if ((toIdx == TCL_INDEX_NONE) ||
+ (fromIdx + 1 > slength + 1) ||
+ (toIdx + 1 < fromIdx + 1)) {
TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
TclDecrRefCount(value3Ptr);
NEXT_INST_F(1, 0, 0);
}
- if (fromIdx < 0) {
- fromIdx = 0;
+ if (fromIdx == TCL_INDEX_NONE) {
+ fromIdx = TCL_INDEX_START;
}
- if (toIdx > endIdx) {
- toIdx = endIdx;
+ if (toIdx + 1 > slength + 1) {
+ toIdx = slength;
}
- if (fromIdx == 0 && toIdx == endIdx) {
+ if ((fromIdx == TCL_INDEX_START) && (toIdx == slength)) {
TclDecrRefCount(OBJ_AT_TOS);
OBJ_AT_TOS = value3Ptr;
TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
@@ -5495,17 +5268,17 @@ TEBCresume(
objResultPtr = value3Ptr;
goto doneStringMap;
}
- ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
- if (length == 0) {
+ ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &slength);
+ if (slength == 0) {
objResultPtr = valuePtr;
goto doneStringMap;
}
ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
- if (length2 > length || length2 == 0) {
+ if (length2 > slength || length2 == 0) {
objResultPtr = valuePtr;
goto doneStringMap;
- } else if (length2 == length) {
- if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) {
+ } else if (length2 == slength) {
+ if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * slength)) {
objResultPtr = valuePtr;
} else {
objResultPtr = value3Ptr;
@@ -5516,22 +5289,22 @@ TEBCresume(
objResultPtr = Tcl_NewUnicodeObj(ustring1, 0);
p = ustring1;
- end = ustring1 + length;
+ end = ustring1 + slength;
for (; ustring1 < end; ustring1++) {
if ((*ustring1 == *ustring2) &&
/* Fix bug [69218ab7b]: restrict max compare length. */
- (end-ustring1 >= length2) && (length2==1 ||
+ ((size_t)(end-ustring1) >= length2) && (length2==1 ||
memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2)
== 0)) {
if (p != ustring1) {
- Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p);
+ TclAppendUnicodeToObj(objResultPtr, p, ustring1-p);
p = ustring1 + length2;
} else {
p += length2;
}
ustring1 = p - 1;
- Tcl_AppendUnicodeToObj(objResultPtr, ustring3, length3);
+ TclAppendUnicodeToObj(objResultPtr, ustring3, length3);
}
}
if (p != ustring1) {
@@ -5539,7 +5312,7 @@ TEBCresume(
* Put the rest of the unmapped chars onto result.
*/
- Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p);
+ TclAppendUnicodeToObj(objResultPtr, p, ustring1 - p);
}
doneStringMap:
TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
@@ -5565,11 +5338,11 @@ TEBCresume(
valuePtr = OBJ_AT_TOS;
TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name,
O2S(valuePtr)));
- ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
+ ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &slength);
match = 1;
- if (length > 0) {
+ if (slength > 0) {
int ch;
- end = ustring1 + length;
+ end = ustring1 + slength;
for (p=ustring1 ; p<end ; ) {
p += TclUniCharToUCS4(p, &ch);
if (!tclStringClassTable[opnd].comparator(ch)) {
@@ -5596,16 +5369,17 @@ TEBCresume(
|| TclHasInternalRep(value2Ptr, &tclStringType)) {
Tcl_UniChar *ustring1, *ustring2;
- ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
+ ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &slength);
ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
- match = TclUniCharMatch(ustring1, length, ustring2, length2,
+ match = TclUniCharMatch(ustring1, slength, ustring2, length2,
nocase);
} else if (TclIsPureByteArray(valuePtr) && !nocase) {
unsigned char *bytes1, *bytes2;
+ size_t wlen1 = 0, wlen2 = 0;
- bytes1 = Tcl_GetByteArrayFromObj(valuePtr, &length);
- bytes2 = Tcl_GetByteArrayFromObj(value2Ptr, &length2);
- match = TclByteArrayMatch(bytes1, length, bytes2, length2, 0);
+ bytes1 = Tcl_GetByteArrayFromObj(valuePtr, &wlen1);
+ bytes2 = Tcl_GetByteArrayFromObj(value2Ptr, &wlen2);
+ match = TclByteArrayMatch(bytes1, wlen1, bytes2, wlen2, 0);
} else {
match = Tcl_StringCaseMatch(TclGetString(valuePtr),
TclGetString(value2Ptr), nocase);
@@ -5626,30 +5400,30 @@ TEBCresume(
{
const char *string1, *string2;
- int trim1, trim2;
+ size_t trim1, trim2;
case INST_STR_TRIM_LEFT:
valuePtr = OBJ_UNDER_TOS; /* String */
value2Ptr = OBJ_AT_TOS; /* TrimSet */
- string2 = TclGetStringFromObj(value2Ptr, &length2);
- string1 = TclGetStringFromObj(valuePtr, &length);
- trim1 = TclTrimLeft(string1, length, string2, length2);
+ string2 = Tcl_GetStringFromObj(value2Ptr, &length2);
+ string1 = Tcl_GetStringFromObj(valuePtr, &slength);
+ trim1 = TclTrimLeft(string1, slength, string2, length2);
trim2 = 0;
goto createTrimmedString;
case INST_STR_TRIM_RIGHT:
valuePtr = OBJ_UNDER_TOS; /* String */
value2Ptr = OBJ_AT_TOS; /* TrimSet */
- string2 = TclGetStringFromObj(value2Ptr, &length2);
- string1 = TclGetStringFromObj(valuePtr, &length);
- trim2 = TclTrimRight(string1, length, string2, length2);
+ string2 = Tcl_GetStringFromObj(value2Ptr, &length2);
+ string1 = Tcl_GetStringFromObj(valuePtr, &slength);
+ trim2 = TclTrimRight(string1, slength, string2, length2);
trim1 = 0;
goto createTrimmedString;
case INST_STR_TRIM:
valuePtr = OBJ_UNDER_TOS; /* String */
value2Ptr = OBJ_AT_TOS; /* TrimSet */
- string2 = TclGetStringFromObj(value2Ptr, &length2);
- string1 = TclGetStringFromObj(valuePtr, &length);
- trim1 = TclTrim(string1, length, string2, length2, &trim2);
+ string2 = Tcl_GetStringFromObj(value2Ptr, &length2);
+ string1 = Tcl_GetStringFromObj(valuePtr, &slength);
+ trim1 = TclTrim(string1, slength, string2, length2, &trim2);
createTrimmedString:
/*
* Careful here; trim set often contains non-ASCII characters so we
@@ -5672,7 +5446,7 @@ TEBCresume(
#endif
NEXT_INST_F(1, 1, 0);
} else {
- objResultPtr = Tcl_NewStringObj(string1+trim1, length-trim1-trim2);
+ objResultPtr = Tcl_NewStringObj(string1+trim1, slength-trim1-trim2);
#ifdef TCL_COMPILE_DEBUG
if (traceInstructions) {
TclPrintObject(stdout, objResultPtr, 30);
@@ -6442,170 +6216,6 @@ TEBCresume(
{
ForeachInfo *infoPtr;
- Var *iterVarPtr, *listVarPtr;
- Tcl_Obj *oldValuePtr, *listPtr, **elements;
- ForeachVarList *varListPtr;
- int numLists, listTmpIndex, listLen, numVars;
- size_t iterNum;
- int varIndex, valIndex, continueLoop, j, iterTmpIndex;
- long i;
-
- case INST_FOREACH_START4: /* DEPRECATED */
- /*
- * Initialize the temporary local var that holds the count of the
- * number of iterations of the loop body to -1.
- */
-
- opnd = TclGetUInt4AtPtr(pc+1);
- infoPtr = (ForeachInfo *)codePtr->auxDataArrayPtr[opnd].clientData;
- iterTmpIndex = infoPtr->loopCtTemp;
- iterVarPtr = LOCAL(iterTmpIndex);
- oldValuePtr = iterVarPtr->value.objPtr;
-
- if (oldValuePtr == NULL) {
- TclNewIntObj(iterVarPtr->value.objPtr, -1);
- Tcl_IncrRefCount(iterVarPtr->value.objPtr);
- } else {
- TclSetIntObj(oldValuePtr, -1);
- }
- TRACE(("%u => loop iter count temp %d\n", opnd, iterTmpIndex));
-
-#ifndef TCL_COMPILE_DEBUG
- /*
- * Remark that the compiler ALWAYS sets INST_FOREACH_STEP4 immediately
- * after INST_FOREACH_START4 - let us just fall through instead of
- * jumping back to the top.
- */
-
- pc += 5;
- TCL_DTRACE_INST_NEXT();
-#else
- NEXT_INST_F(5, 0, 0);
-#endif
-
- case INST_FOREACH_STEP4: /* DEPRECATED */
- /*
- * "Step" a foreach loop (i.e., begin its next iteration) by assigning
- * the next value list element to each loop var.
- */
-
- opnd = TclGetUInt4AtPtr(pc+1);
- TRACE(("%u => ", opnd));
- infoPtr = (ForeachInfo *)codePtr->auxDataArrayPtr[opnd].clientData;
- numLists = infoPtr->numLists;
-
- /*
- * Increment the temp holding the loop iteration number.
- */
-
- iterVarPtr = LOCAL(infoPtr->loopCtTemp);
- valuePtr = iterVarPtr->value.objPtr;
- iterNum = (size_t)valuePtr->internalRep.wideValue + 1;
- TclSetIntObj(valuePtr, iterNum);
-
- /*
- * Check whether all value lists are exhausted and we should stop the
- * loop.
- */
-
- continueLoop = 0;
- listTmpIndex = infoPtr->firstValueTemp;
- for (i = 0; i < numLists; i++) {
- varListPtr = infoPtr->varLists[i];
- numVars = varListPtr->numVars;
-
- listVarPtr = LOCAL(listTmpIndex);
- listPtr = listVarPtr->value.objPtr;
- if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
- TRACE_APPEND(("ERROR converting list %ld, \"%.30s\": %s\n",
- i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
- goto gotError;
- }
- if ((size_t)listLen > iterNum * numVars) {
- continueLoop = 1;
- }
- listTmpIndex++;
- }
-
- /*
- * If some var in some var list still has a remaining list element
- * iterate one more time. Assign to var the next element from its
- * value list. We already checked above that each list temp holds a
- * valid list object (by calling Tcl_ListObjLength), but cannot rely
- * on that check remaining valid: one list could have been shimmered
- * as a side effect of setting a traced variable.
- */
-
- if (continueLoop) {
- listTmpIndex = infoPtr->firstValueTemp;
- for (i = 0; i < numLists; i++) {
- varListPtr = infoPtr->varLists[i];
- numVars = varListPtr->numVars;
-
- listVarPtr = LOCAL(listTmpIndex);
- listPtr = TclListObjCopy(NULL, listVarPtr->value.objPtr);
- TclListObjGetElements(interp, listPtr, &listLen, &elements);
-
- valIndex = (iterNum * numVars);
- for (j = 0; j < numVars; j++) {
- if (valIndex >= listLen) {
- TclNewObj(valuePtr);
- } else {
- valuePtr = elements[valIndex];
- }
-
- varIndex = varListPtr->varIndexes[j];
- varPtr = LOCAL(varIndex);
- while (TclIsVarLink(varPtr)) {
- varPtr = varPtr->value.linkPtr;
- }
- if (TclIsVarDirectWritable(varPtr)) {
- value2Ptr = varPtr->value.objPtr;
- if (valuePtr != value2Ptr) {
- if (value2Ptr != NULL) {
- TclDecrRefCount(value2Ptr);
- }
- varPtr->value.objPtr = valuePtr;
- Tcl_IncrRefCount(valuePtr);
- }
- } else {
- DECACHE_STACK_INFO();
- if (TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL,
- valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
- CACHE_STACK_INFO();
- TRACE_APPEND((
- "ERROR init. index temp %d: %s\n",
- varIndex, O2S(Tcl_GetObjResult(interp))));
- TclDecrRefCount(listPtr);
- goto gotError;
- }
- CACHE_STACK_INFO();
- }
- valIndex++;
- }
- TclDecrRefCount(listPtr);
- listTmpIndex++;
- }
- }
- TRACE_APPEND(("%d lists, iter %" TCL_Z_MODIFIER "u, %s loop\n",
- numLists, iterNum, (continueLoop? "continue" : "exit")));
-
- /*
- * Run-time peep-hole optimisation: the compiler ALWAYS follows
- * INST_FOREACH_STEP4 with an INST_JUMP_FALSE. We just skip that
- * instruction and jump direct from here.
- */
-
- pc += 5;
- if (*pc == INST_JUMP_FALSE1) {
- NEXT_INST_F((continueLoop? 2 : TclGetInt1AtPtr(pc+1)), 0, 0);
- } else {
- NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
- }
-
- }
- {
- ForeachInfo *infoPtr;
Tcl_Obj *listPtr, **elements;
ForeachVarList *varListPtr;
int numLists, listLen, numVars;
@@ -7237,7 +6847,7 @@ TEBCresume(
opnd = TclGetUInt4AtPtr(pc+1);
TRACE(("%u => ", opnd));
dictPtr = POP_OBJECT();
- searchPtr = (Tcl_DictSearch *)ckalloc(sizeof(Tcl_DictSearch));
+ searchPtr = (Tcl_DictSearch *)Tcl_Alloc(sizeof(Tcl_DictSearch));
if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
&valuePtr, &done) != TCL_OK) {
@@ -7248,7 +6858,7 @@ TEBCresume(
*/
Tcl_DecrRefCount(dictPtr);
- ckfree(searchPtr);
+ Tcl_Free(searchPtr);
TRACE_ERROR(interp);
goto gotError;
}
@@ -7333,7 +6943,7 @@ TEBCresume(
TRACE_ERROR(interp);
goto gotError;
}
- if (length != duiPtr->length) {
+ if ((size_t)length != duiPtr->length) {
Tcl_Panic("dictUpdateStart argument length mismatch");
}
for (i=0 ; i<length ; i++) {
@@ -7702,11 +7312,12 @@ TEBCresume(
}
if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
const unsigned char *pcBeg;
+ size_t xxx1length;
- bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg, NULL);
+ bytes = GetSrcInfoForPc(pc, codePtr, &xxx1length, &pcBeg, NULL);
DECACHE_STACK_INFO();
TclLogCommandInfo(interp, codePtr->source, bytes,
- bytes ? length : 0, pcBeg, tosPtr);
+ bytes ? xxx1length : 0, pcBeg, tosPtr);
CACHE_STACK_INFO();
}
iPtr->flags &= ~ERR_ALREADY_LOGGED;
@@ -7801,9 +7412,9 @@ TEBCresume(
#ifdef TCL_COMPILE_DEBUG
if (traceInstructions) {
fprintf(stdout, " ... found catch at %d, catchTop=%d, "
- "unwound to %ld, new pc %u\n",
+ "unwound to %ld, new pc %" TCL_Z_MODIFIER "u\n",
rangePtr->codeOffset, (int) (catchTop - initCatchTop - 1),
- (long)*catchTop, (unsigned) rangePtr->catchOffset);
+ (long)*catchTop, (size_t) rangePtr->catchOffset);
}
#endif
pc = (codePtr->codeStart + rangePtr->catchOffset);
@@ -7839,10 +7450,10 @@ TEBCresume(
if (tosPtr < initTosPtr) {
fprintf(stderr,
- "\nTclNRExecuteByteCode: abnormal return at pc %u: "
+ "\nTclNRExecuteByteCode: abnormal return at pc %" TCL_Z_MODIFIER "u: "
"stack top %d < entry stack top %d\n",
- (unsigned)(pc - codePtr->codeStart),
- (unsigned) CURR_DEPTH, (unsigned) 0);
+ (size_t)(pc - codePtr->codeStart),
+ (int) CURR_DEPTH, 0);
Tcl_Panic("TclNRExecuteByteCode execution failure: end stack top < start stack top");
}
CLANG_ASSERT(bcFramePtr);
@@ -7868,8 +7479,9 @@ TEBCresume(
instStartCmdFailed:
{
const char *bytes;
+ size_t xxx1length;
- length = 0;
+ xxx1length = 0;
if (TclInterpReady(interp) == TCL_ERROR) {
goto gotError;
@@ -7886,11 +7498,11 @@ TEBCresume(
*/
codePtr->flags |= TCL_BYTECODE_RECOMPILE;
- bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL, NULL);
+ bytes = GetSrcInfoForPc(pc, codePtr, &xxx1length, NULL, NULL);
opnd = TclGetUInt4AtPtr(pc+1);
pc += (opnd-1);
assert(bytes);
- PUSH_OBJECT(Tcl_NewStringObj(bytes, length));
+ PUSH_OBJECT(Tcl_NewStringObj(bytes, xxx1length));
goto instEvalStk;
}
}
@@ -9061,10 +8673,9 @@ PrintByteCodeInfo(
Proc *procPtr = codePtr->procPtr;
Interp *iPtr = (Interp *) *codePtr->interpHandle;
- fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %u, interp 0x%p (epoch %u)\n",
- codePtr, (size_t)codePtr->refCount, codePtr->compileEpoch, iPtr,
+ fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp 0x%p (epoch %" TCL_Z_MODIFIER "u)\n",
+ codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr,
iPtr->compileEpoch);
-
fprintf(stdout, " Source: ");
TclPrintSource(stdout, codePtr->source, 60);
@@ -9090,7 +8701,7 @@ PrintByteCodeInfo(
#endif /* TCL_COMPILE_STATS */
if (procPtr != NULL) {
fprintf(stdout,
- " Proc 0x%p, refCt %d, args %d, compiled locals %d\n",
+ " Proc 0x%p, refCt %" TCL_Z_MODIFIER "u, args %d, compiled locals %d\n",
procPtr, procPtr->refCount, procPtr->numArgs,
procPtr->numCompiledLocals);
}
@@ -9142,14 +8753,14 @@ ValidatePcAndStackTop(
pc);
Tcl_Panic("TclNRExecuteByteCode execution failure: bad pc");
}
- if ((unsigned) opCode > LAST_INST_OPCODE) {
+ if ((unsigned) opCode >= LAST_INST_OPCODE) {
fprintf(stderr, "\nBad opcode %d at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode\n",
(unsigned) opCode, relativePc);
Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode");
}
if (checkStack &&
((stackTop < 0) || (stackTop > stackUpperBound))) {
- int numChars;
+ size_t numChars;
const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL);
fprintf(stderr, "\nBad stack top %d at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode (min 0, max %i)",
@@ -9205,20 +8816,11 @@ IllegalExprOperandType(
if (opcode == INST_EXPON) {
op = "**";
} else if (opcode <= INST_LNOT) {
- op = operatorStrings[opcode - INST_LOR];
+ op = operatorStrings[opcode - INST_BITOR];
}
if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
- int numBytes;
- const char *bytes = TclGetStringFromObj(opndPtr, &numBytes);
-
- if (numBytes == 0) {
- description = "empty string";
- } else if (TclCheckBadOctal(NULL, bytes)) {
- description = "invalid octal number";
- } else {
- description = "non-numeric string";
- }
+ description = "non-numeric string";
} else if (type == TCL_NUMBER_NAN) {
description = "non-numeric floating-point value";
} else if (type == TCL_NUMBER_DOUBLE) {
@@ -9229,7 +8831,8 @@ IllegalExprOperandType(
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't use %s as operand of \"%s\"", description, op));
+ "can't use %s \"%s\" as operand of \"%s\"", description,
+ TclGetString(opndPtr), op));
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL);
}
@@ -9306,7 +8909,8 @@ TclGetSrcInfoForPc(
ExtCmdLoc *eclPtr;
ECL *locPtr = NULL;
- int srcOffset, i;
+ size_t srcOffset;
+ int i;
Interp *iPtr = (Interp *) *codePtr->interpHandle;
Tcl_HashEntry *hePtr =
Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
@@ -9352,7 +8956,7 @@ GetSrcInfoForPc(
* 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
+ size_t *lengthPtr, /* If non-NULL, the location where the length
* of the command's source should be stored.
* If NULL, no length is stored. */
const unsigned char **pcBeg,/* If non-NULL, the bytecode location
@@ -9362,18 +8966,18 @@ GetSrcInfoForPc(
* of the command containing the pc should
* be stored. */
{
- int pcOffset = (pc - codePtr->codeStart);
- int numCmds = codePtr->numCommands;
+ size_t pcOffset = (size_t)(pc - codePtr->codeStart);
+ size_t numCmds = codePtr->numCommands;
unsigned char *codeDeltaNext, *codeLengthNext;
unsigned char *srcDeltaNext, *srcLengthNext;
- int codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i;
+ size_t 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. */
int bestCmdIdx = -1;
/* The pc must point within the bytecode */
- assert ((pcOffset >= 0) && (pcOffset < codePtr->numCodeBytes));
+ assert (pcOffset < (size_t)codePtr->numCodeBytes);
/*
* Decode the code and source offset and length for each command. The
@@ -9516,8 +9120,8 @@ GetExceptRangeForPc(
ExceptionRange *rangeArrayPtr;
int numRanges = codePtr->numExceptRanges;
ExceptionRange *rangePtr;
- int pcOffset = pc - codePtr->codeStart;
- int start;
+ size_t pcOffset = pc - codePtr->codeStart;
+ size_t start;
if (numRanges == 0) {
return NULL;
@@ -9695,9 +9299,8 @@ EvalStatsCmd(
double strBytesSharedMultX, strBytesSharedOnce;
double numInstructions, currentHeaderBytes;
size_t numCurrentByteCodes, numByteCodeLits;
- size_t refCountSum, literalMgmtBytes, sum;
+ size_t refCountSum, literalMgmtBytes, sum, decadeHigh, length;
size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade, i;
- int decadeHigh, length;
char *litTableStats;
LiteralEntry *entryPtr;
Tcl_Obj *objPtr;
@@ -9739,8 +9342,8 @@ EvalStatsCmd(
Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");
Tcl_AppendPrintfToObj(objPtr,
- "Compilation and execution statistics for interpreter %#" TCL_Z_MODIFIER "x\n",
- (size_t)iPtr);
+ "Compilation and execution statistics for interpreter %p\n",
+ iPtr);
Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed\t%" TCL_Z_MODIFIER "u\n",
statsPtr->numExecutions);
@@ -9787,11 +9390,11 @@ EvalStatsCmd(
statsPtr->currentByteCodeBytes);
Tcl_AppendPrintfToObj(objPtr, " Literal bytes\t\t%.6g\n",
currentLiteralBytes);
- Tcl_AppendPrintfToObj(objPtr, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n",
- (unsigned long) sizeof(LiteralTable),
- (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)),
- (unsigned long) (iPtr->literalTable.numEntries * sizeof(LiteralEntry)),
- (unsigned long) (iPtr->literalTable.numEntries * sizeof(Tcl_Obj)),
+ Tcl_AppendPrintfToObj(objPtr, " table %" TCL_Z_MODIFIER "u + bkts %" TCL_Z_MODIFIER "u + entries %" TCL_Z_MODIFIER "u + objects %" TCL_Z_MODIFIER "u + strings %.6g\n",
+ sizeof(LiteralTable),
+ iPtr->literalTable.numBuckets * sizeof(LiteralEntry *),
+ iPtr->literalTable.numEntries * sizeof(LiteralEntry),
+ iPtr->literalTable.numEntries * sizeof(Tcl_Obj),
statsPtr->currentLitStringBytes);
Tcl_AppendPrintfToObj(objPtr, " Mean code/source\t\t%.1f\n",
currentCodeBytes / statsPtr->currentSrcBytes);
@@ -9839,7 +9442,7 @@ EvalStatsCmd(
if (TclHasInternalRep(entryPtr->objPtr, &tclByteCodeType)) {
numByteCodeLits++;
}
- (void) TclGetStringFromObj(entryPtr->objPtr, &length);
+ (void) Tcl_GetStringFromObj(entryPtr->objPtr, &length);
refCountSum += entryPtr->refCount;
objBytesIfUnshared += (entryPtr->refCount * sizeof(Tcl_Obj));
strBytesIfUnshared += (entryPtr->refCount * (length+1));
@@ -9862,7 +9465,7 @@ EvalStatsCmd(
Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%" TCL_Z_MODIFIER "u\n",
statsPtr->numLiteralsCreated);
- Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%d (%0.1f%% of current objects)\n",
+ Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of current objects)\n",
globalTablePtr->numEntries,
Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed));
Tcl_AppendPrintfToObj(objPtr, " ByteCode literals\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of current literals)\n",
@@ -9954,14 +9557,14 @@ EvalStatsCmd(
for (i = 0; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->literalCount[i];
- Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
+ Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "u\t\t%8.0f%%\n",
decadeHigh, Percent(sum, statsPtr->numLiteralsCreated));
}
litTableStats = TclLiteralStats(globalTablePtr);
Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n",
litTableStats);
- ckfree(litTableStats);
+ Tcl_Free(litTableStats);
/*
* Source and ByteCode size distributions.
@@ -9978,15 +9581,16 @@ EvalStatsCmd(
}
for (i = 31; i != (size_t)-1; i--) {
if (statsPtr->srcCount[i] > 0) {
- maxSizeDecade = i;
- break;
+ break; /* maxSizeDecade to consume 'i' value
+ * below... */
}
}
+ maxSizeDecade = i;
sum = 0;
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->srcCount[i];
- Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
+ Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "u\t\t%8.0f%%\n",
decadeHigh, Percent(sum, statsPtr->numCompilations));
}
@@ -10001,15 +9605,16 @@ EvalStatsCmd(
}
for (i = 31; i != (size_t)-1; i--) {
if (statsPtr->byteCodeCount[i] > 0) {
- maxSizeDecade = i;
- break;
+ break; /* maxSizeDecade to consume 'i' value
+ * below... */
}
}
+ maxSizeDecade = i;
sum = 0;
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
sum += statsPtr->byteCodeCount[i];
- Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
+ Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_Z_MODIFIER "u\t\t%8.0f%%\n",
decadeHigh, Percent(sum, statsPtr->numCompilations));
}
@@ -10024,10 +9629,11 @@ EvalStatsCmd(
}
for (i = 31; i != (size_t)-1; i--) {
if (statsPtr->lifetimeCount[i] > 0) {
- maxSizeDecade = i;
- break;
+ break; /* maxSizeDecade to consume 'i' value
+ * below... */
}
}
+ maxSizeDecade = i;
sum = 0;
for (i = minSizeDecade; i <= maxSizeDecade; i++) {
decadeHigh = (1 << (i+1)) - 1;
@@ -10041,7 +9647,7 @@ EvalStatsCmd(
*/
Tcl_AppendPrintfToObj(objPtr, "\nInstruction counts:\n");
- for (i = 0; i <= LAST_INST_OPCODE; i++) {
+ for (i = 0; i < LAST_INST_OPCODE; i++) {
Tcl_AppendPrintfToObj(objPtr, "%20s %8" TCL_Z_MODIFIER "u ",
tclInstructionTable[i].name, statsPtr->instructionCount[i]);
if (statsPtr->instructionCount[i]) {
@@ -10054,7 +9660,7 @@ EvalStatsCmd(
#ifdef TCL_MEM_DEBUG
Tcl_AppendPrintfToObj(objPtr, "\nHeap Statistics:\n");
- TclDumpMemoryInfo((ClientData) objPtr, 1);
+ TclDumpMemoryInfo(objPtr, 1);
#endif
Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");
@@ -10062,7 +9668,7 @@ EvalStatsCmd(
Tcl_SetObjResult(interp, objPtr);
} else {
Tcl_Channel outChan;
- char *str = TclGetStringFromObj(objv[1], &length);
+ char *str = Tcl_GetStringFromObj(objv[1], &length);
if (length) {
if (strcmp(str, "stdout") == 0) {