diff options
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r-- | generic/tclExecute.c | 822 |
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) { |