diff options
| -rw-r--r-- | generic/tclCompile.c | 34 | ||||
| -rw-r--r-- | generic/tclExecute.c | 547 |
2 files changed, 313 insertions, 268 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c index efb652e..d5f5125 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.142 2007/11/16 14:11:52 dkf Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.143 2007/11/18 17:48:02 dkf Exp $ */ #include "tclInt.h" @@ -1333,7 +1333,7 @@ TclCompileScript( && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES) && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) { int savedNumCmds = envPtr->numCommands; - unsigned int savedCodeNext = + unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart; int update = 0, code; @@ -1386,7 +1386,7 @@ TclCompileScript( unsigned char *fixPtr = envPtr->codeStart + savedCodeNext + 1; - unsigned int fixLen = envPtr->codeNext + unsigned fixLen = envPtr->codeNext - envPtr->codeStart - savedCodeNext; TclStoreInt4AtPtr(fixLen, fixPtr); @@ -2756,7 +2756,7 @@ TclFixupForwardJump( { unsigned char *jumpPc, *p; int firstCmd, lastCmd, firstRange, lastRange, k; - unsigned int numBytes; + unsigned numBytes; if (jumpDist <= distThreshold) { jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset); @@ -3408,10 +3408,10 @@ TclDisassembleByteCodeObj( Tcl_AppendPrintfToObj(bufferObj, " Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n", (unsigned long) codePtr->structureSize, - (unsigned long) (sizeof(ByteCode) - (sizeof(size_t) + sizeof(Tcl_Time))), + (unsigned long) (sizeof(ByteCode) - sizeof(size_t) - sizeof(Tcl_Time)), codePtr->numCodeBytes, (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)), - (unsigned long) (codePtr->numExceptRanges * sizeof(ExceptionRange)), + (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)), (unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)), codePtr->numCmdLocBytes); #endif /* TCL_COMPILE_STATS */ @@ -3512,7 +3512,7 @@ TclDisassembleByteCodeObj( srcLengthNext = codePtr->srcLengthStart; codeOffset = srcOffset = 0; for (i = 0; i < numCmds; i++) { - if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) { + if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) { codeDeltaNext++; delta = TclGetInt4AtPtr(codeDeltaNext); codeDeltaNext += 4; @@ -3522,7 +3522,7 @@ TclDisassembleByteCodeObj( } codeOffset += delta; - if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) { + if ((unsigned) *codeLengthNext == (unsigned) 0xFF) { codeLengthNext++; codeLen = TclGetInt4AtPtr(codeLengthNext); codeLengthNext += 4; @@ -3531,7 +3531,7 @@ TclDisassembleByteCodeObj( codeLengthNext++; } - if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) { + if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) { srcDeltaNext++; delta = TclGetInt4AtPtr(srcDeltaNext); srcDeltaNext += 4; @@ -3541,7 +3541,7 @@ TclDisassembleByteCodeObj( } srcOffset += delta; - if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) { + if ((unsigned) *srcLengthNext == (unsigned) 0xFF) { srcLengthNext++; srcLen = TclGetInt4AtPtr(srcLengthNext); srcLengthNext += 4; @@ -3571,7 +3571,7 @@ TclDisassembleByteCodeObj( codeOffset = srcOffset = 0; pc = codeStart; for (i = 0; i < numCmds; i++) { - if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) { + if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) { codeDeltaNext++; delta = TclGetInt4AtPtr(codeDeltaNext); codeDeltaNext += 4; @@ -3581,7 +3581,7 @@ TclDisassembleByteCodeObj( } codeOffset += delta; - if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) { + if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) { srcDeltaNext++; delta = TclGetInt4AtPtr(srcDeltaNext); srcDeltaNext += 4; @@ -3591,7 +3591,7 @@ TclDisassembleByteCodeObj( } srcOffset += delta; - if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) { + if ((unsigned) *srcLengthNext == (unsigned) 0xFF) { srcLengthNext++; srcLen = TclGetInt4AtPtr(srcLengthNext); srcLengthNext += 4; @@ -3647,7 +3647,7 @@ FormatInstruction( unsigned char opCode = *pc; register InstructionDesc *instDesc = &tclInstructionTable[opCode]; unsigned char *codeStart = codePtr->codeStart; - unsigned int pcOffset = (pc - codeStart); + unsigned pcOffset = pc - codeStart; int opnd = 0, i, j, numBytes = 1; int localCt = procPtr ? procPtr->numCompiledLocals : 0; CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL; @@ -3684,7 +3684,7 @@ FormatInstruction( if (opCode == INST_PUSH1) { suffixObj = codePtr->objArrayPtr[opnd]; } - Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned int) opnd); + Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); break; case OPERAND_AUX4: case OPERAND_UINT4: @@ -3695,7 +3695,7 @@ FormatInstruction( sprintf(suffixBuffer+strlen(suffixBuffer), ", %u cmds start here", opnd); } - Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned int) opnd); + Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); if (instDesc->opTypes[i] == OPERAND_AUX4) { auxPtr = &codePtr->auxDataArrayPtr[opnd]; } @@ -3721,7 +3721,7 @@ FormatInstruction( if (localPtr != NULL) { if (opnd >= localCt) { Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)", - (unsigned int) opnd, localCt); + (unsigned) opnd, localCt); } for (j = 0; j < opnd; j++) { localPtr = localPtr->nextPtr; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 710da15..3f5ec50 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.351 2007/11/17 15:12:43 das Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.352 2007/11/18 17:48:02 dkf Exp $ */ #include "tclInt.h" @@ -295,7 +295,7 @@ VarHashCreateVar( if (traceInstructions) { \ fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \ (int) CURR_DEPTH, \ - (unsigned int)(pc - codePtr->codeStart), \ + (unsigned)(pc - codePtr->codeStart), \ GetOpcodeName(pc)); \ printf a; \ } @@ -307,7 +307,7 @@ VarHashCreateVar( if (traceInstructions) { \ fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \ (int) CURR_DEPTH, \ - (unsigned int)(pc - codePtr->codeStart), \ + (unsigned)(pc - codePtr->codeStart), \ GetOpcodeName(pc)); \ printf a; \ TclPrintObject(stdout, objPtr, 30); \ @@ -461,18 +461,17 @@ static Tcl_ObjType dictIteratorType = { #if (LONG_MAX == 0x7fffffff) -/* +/* * Maximum base that, when raised to powers 2, 3, ... 8, fits in a 32-bit * signed integer */ static const long MaxBase32[7] = {46340, 1290, 215, 73, 35, 21, 14}; -/* - * Table giving 3, 4, ..., 11, raised to the powers 9, 10, ..., - * as far as they fit in a 32-bit signed integer. Exp32Index[i] gives - * the starting index of powers of i+3; Exp32Value[i] gives the corresponding - * powers. +/* + * Table giving 3, 4, ..., 11, raised to the powers 9, 10, ..., as far as they + * fit in a 32-bit signed integer. Exp32Index[i] gives the starting index of + * powers of i+3; Exp32Value[i] gives the corresponding powers. */ static const unsigned short Exp32Index[] = { @@ -492,13 +491,13 @@ static const long Exp32Value[] = { #if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) /* - * Maximum base that, when raised to powers 2, 3, ..., 16, fits in a + * Maximum base that, when raised to powers 2, 3, ..., 16, fits in a * Tcl_WideInt. */ static Tcl_WideInt MaxBaseWide[15]; -/* +/* *Table giving 3, 4, ..., 13 raised to powers greater than 16 when the * results fit in a 64-bit signed integer. */ @@ -658,29 +657,34 @@ InitByteCodeExecution( } #endif #ifdef TCL_COMPILE_STATS - Tcl_CreateObjCommand(interp, "evalstats", EvalStatsCmd, - (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "evalstats", EvalStatsCmd, NULL, NULL); #endif /* TCL_COMPILE_STATS */ #if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) - /* + /* * Fill in a table of what base can be raised to powers 2, 3, ... 16 * without overflowing a Tcl_WideInt */ - for (i = 2; i <= 16; ++i) { - /* Compute an initial guess in floating point */ + for (i = 2; i <= 16; ++i) { + /* + * Compute an initial guess in floating point. + */ w = (Tcl_WideInt) pow((double) LLONG_MAX, 1.0 / i) + 1; - /* Correct the guess if it's too high */ + /* + * Correct the guess if it's too high. + */ for (;;) { x = LLONG_MAX; for (j = 0; j < i; ++j) { x /= w; } - if (x == 1) break; + if (x == 1) { + break; + } --w; } @@ -719,9 +723,8 @@ TclCreateExecEnv( * environment is being created. */ { ExecEnv *eePtr = (ExecEnv *) ckalloc(sizeof(ExecEnv)); - ExecStack *esPtr = (ExecStack *) - ckalloc((size_t) (sizeof(ExecStack) - + (TCL_STACK_INITIAL_SIZE -1) * sizeof(Tcl_Obj *))); + ExecStack *esPtr = (ExecStack *) ckalloc(sizeof(ExecStack) + + (size_t) (TCL_STACK_INITIAL_SIZE-1) * sizeof(Tcl_Obj *)); eePtr->execStackPtr = esPtr; TclNewBooleanObj(eePtr->constants[0], 0); @@ -891,7 +894,7 @@ GrowEvaluationStack( if (move) { move = esPtr->tosPtr - markerPtr; } - needed = growth + move + 1; /* add the marker */ + needed = growth + move + 1; /* Add the marker. */ /* * Check if there is enough room in the next stack (if there is one, it @@ -1177,10 +1180,13 @@ Tcl_ExprObj( } } if (objPtr->typePtr != &tclByteCodeType) { + /* + * TIP #280: No invoker (yet) - Expression compilation. + */ - /* TIP #280: No invoker (yet) - Expression compilation. */ int length; const char *string = TclGetStringFromObj(objPtr, &length); + TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0); TclCompileExpr(interp, string, length, &compEnv); @@ -1415,19 +1421,25 @@ TclIncrObj( } if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) { - /* Produce error message (reparse?!) */ + /* + * Produce error message (reparse?!) + */ + return TclGetIntFromObj(interp, valuePtr, &type1); } if (GetNumberFromObj(NULL, incrPtr, &ptr2, &type2) != TCL_OK) { - /* Produce error message (reparse?!) */ + /* + * Produce error message (reparse?!) + */ + TclGetIntFromObj(interp, incrPtr, &type1); Tcl_AddErrorInfo(interp, "\n (reading increment)"); return TCL_ERROR; } if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { - long augend = *((const long *)ptr1); - long addend = *((const long *)ptr2); + long augend = *((const long *) ptr1); + long addend = *((const long *) ptr2); long sum = augend + addend; /* @@ -1442,8 +1454,8 @@ TclIncrObj( } #ifndef NO_WIDE_TYPE { - Tcl_WideInt w1 = (Tcl_WideInt)augend; - Tcl_WideInt w2 = (Tcl_WideInt)addend; + Tcl_WideInt w1 = (Tcl_WideInt) augend; + Tcl_WideInt w2 = (Tcl_WideInt) addend; /* * We know the sum value is outside the long range, so we use the @@ -1476,6 +1488,7 @@ TclIncrObj( #ifndef NO_WIDE_TYPE if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) { Tcl_WideInt w1, w2, sum; + TclGetWideIntFromObj(NULL, valuePtr, &w1); TclGetWideIntFromObj(NULL, incrPtr, &w2); sum = w1 + w2; @@ -1530,6 +1543,13 @@ TclExecuteByteCode( #define iPtr ((Interp *) interp) /* + * Check just the read-traced/write-traced bit of a variable. + */ + +#define ReadTraced(varPtr) ((varPtr)->flags & VAR_TRACED_READ) +#define WriteTraced(varPtr) ((varPtr)->flags & VAR_TRACED_WRITE) + + /* * Constants: variables that do not change during the execution, used * sporadically. */ @@ -1772,7 +1792,7 @@ TclExecuteByteCode( } else if (*pc == INST_PUSH1) { goto instPush1Peephole; } - + switch (*pc) { case INST_SYNTAX: case INST_RETURN_IMM: { @@ -2159,7 +2179,7 @@ TclExecuteByteCode( TRACE(("%u => call ", objc)); } else { fprintf(stdout, "%d: (%u) invoking ", iPtr->numLevels, - (unsigned int)(pc - codePtr->codeStart)); + (unsigned)(pc - codePtr->codeStart)); } for (i = 0; i < objc; i++) { TclPrintObject(stdout, objv[i], 15); @@ -2387,7 +2407,7 @@ TclExecuteByteCode( if (result == TCL_OK) { objResultPtr = valuePtr; TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr); - NEXT_INST_F(1, 1, -1); /* already has right refct */ + NEXT_INST_F(1, 1, -1); /* Already has right refct. */ } else { TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(objPtr)), Tcl_GetObjResult(interp)); @@ -2471,7 +2491,7 @@ TclExecuteByteCode( arrayPtr = arrayPtr->value.linkPtr; } TRACE(("%u \"%.30s\" => ", opnd, O2S(part2Ptr))); - if (TclIsVarArray(arrayPtr) && !(arrayPtr->flags & VAR_TRACED_READ)) { + if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)) { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); if (varPtr && TclIsVarDirectReadable(varPtr)) { /* @@ -2539,8 +2559,8 @@ TclExecuteByteCode( */ DECACHE_STACK_INFO(); - objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, - TCL_LEAVE_ERR_MSG, opnd); + objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr, + part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd); CACHE_STACK_INFO(); if (objResultPtr) { TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); @@ -2590,7 +2610,7 @@ TclExecuteByteCode( while (TclIsVarLink(arrayPtr)) { arrayPtr = arrayPtr->value.linkPtr; } - if (TclIsVarArray(arrayPtr) && !(arrayPtr->flags & VAR_TRACED_WRITE)) { + if (TclIsVarArray(arrayPtr) && !WriteTraced(arrayPtr)) { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); if (varPtr && TclIsVarDirectWritable(varPtr)) { tosPtr--; @@ -2692,13 +2712,13 @@ TclExecuteByteCode( part1Ptr = objPtr; #ifdef TCL_COMPILE_DEBUG if (part2Ptr == NULL) { - TRACE(("\"%.30s\" <- \"%.30s\" =>", O2S(part1Ptr), O2S(valuePtr))); + TRACE(("\"%.30s\" <- \"%.30s\" =>", O2S(part1Ptr),O2S(valuePtr))); } else { TRACE(("\"%.30s(%.30s)\" <- \"%.30s\" => ", O2S(part1Ptr), O2S(part2Ptr), O2S(valuePtr))); } #endif - varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr, TCL_LEAVE_ERR_MSG, + varPtr = TclObjLookupVarEx(interp, objPtr,part2Ptr, TCL_LEAVE_ERR_MSG, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (varPtr) { cleanup = ((part2Ptr == NULL)? 2 : 3); @@ -2884,8 +2904,8 @@ TclExecuteByteCode( } part1Ptr = objPtr; opnd = -1; - varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr, TCL_LEAVE_ERR_MSG, - "read", 1, 1, &arrayPtr); + varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr, + TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr); if (varPtr) { cleanup = ((part2Ptr == NULL)? 1 : 2); goto doIncrVar; @@ -3112,14 +3132,12 @@ TclExecuteByteCode( * Start of INST_EXIST instructions. */ { - int opnd, pcAdjustment; Tcl_Obj *part1Ptr, *part2Ptr; Var *varPtr, *arrayPtr; -#define ReadTraced(varPtr) ((varPtr)->flags & VAR_TRACED_READ) + case INST_EXIST_SCALAR: { + int opnd = TclGetUInt4AtPtr(pc+1); - case INST_EXIST_SCALAR: - opnd = TclGetUInt4AtPtr(pc+1); varPtr = &(compiledLocals[opnd]); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; @@ -3128,16 +3146,18 @@ TclExecuteByteCode( if (ReadTraced(varPtr)) { DECACHE_STACK_INFO(); TclObjCallVarTraces(iPtr, NULL, varPtr, NULL, NULL, - TCL_TRACE_READS, 0, opnd); + TCL_TRACE_READS, 0, opnd); CACHE_STACK_INFO(); if (TclIsVarUndefined(varPtr)) { TclCleanupVar(varPtr, NULL); varPtr = NULL; } } + /* * Tricky! Arrays always exist. */ + if (varPtr == NULL || TclIsVarUndefined(varPtr)) { objResultPtr = constants[0]; } else { @@ -3145,9 +3165,11 @@ TclExecuteByteCode( } TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_F(5, 0, 1); + } + + case INST_EXIST_ARRAY: { + int opnd = TclGetUInt4AtPtr(pc+1); - case INST_EXIST_ARRAY: - opnd = TclGetUInt4AtPtr(pc+1); part2Ptr = OBJ_AT_TOS; arrayPtr = &(compiledLocals[opnd]); while (TclIsVarLink(arrayPtr)) { @@ -3187,10 +3209,10 @@ TclExecuteByteCode( } TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_F(5, 1, 1); + } case INST_EXIST_ARRAY_STK: cleanup = 2; - pcAdjustment = 1; part2Ptr = OBJ_AT_TOS; /* element name */ part1Ptr = OBJ_UNDER_TOS; /* array name */ TRACE(("\"%.30s(%.30s)\" => ", O2S(part1Ptr), O2S(part2Ptr))); @@ -3198,7 +3220,6 @@ TclExecuteByteCode( case INST_EXIST_STK: cleanup = 1; - pcAdjustment = 1; part2Ptr = NULL; part1Ptr = OBJ_AT_TOS; /* variable name */ TRACE(("\"%.30s\" => ", O2S(part1Ptr))); @@ -3209,7 +3230,7 @@ TclExecuteByteCode( if (varPtr) { if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) { DECACHE_STACK_INFO(); - TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr, part2Ptr, + TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,part2Ptr, TCL_TRACE_READS, 0, -1); CACHE_STACK_INFO(); } @@ -3224,7 +3245,7 @@ TclExecuteByteCode( objResultPtr = constants[TclIsVarUndefined(varPtr) ? 0 : 1]; } TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); - NEXT_INST_V(pcAdjustment, cleanup, 1); + NEXT_INST_V(1, cleanup, 1); } /* @@ -3318,8 +3339,12 @@ TclExecuteByteCode( if ((varPtr != otherPtr) && !TclIsVarTraced(varPtr) && (TclIsVarUndefined(varPtr) || TclIsVarLink(varPtr))) { if (!TclIsVarUndefined(varPtr)) { - /* Then it is a defined link */ + /* + * Then it is a defined link. + */ + Var *linkPtr = varPtr->value.linkPtr; + if (linkPtr == otherPtr) { goto doLinkVarsDone; } @@ -3352,20 +3377,18 @@ TclExecuteByteCode( } case INST_JUMP1: { - int opnd; + int opnd = TclGetInt1AtPtr(pc+1); - opnd = TclGetInt1AtPtr(pc+1); TRACE(("%d => new pc %u\n", opnd, - (unsigned int)(pc + opnd - codePtr->codeStart))); + (unsigned)(pc + opnd - codePtr->codeStart))); NEXT_INST_F(opnd, 0, 0); } case INST_JUMP4: { - int opnd; + int opnd = TclGetInt4AtPtr(pc+1); - opnd = TclGetInt4AtPtr(pc+1); TRACE(("%d => new pc %u\n", opnd, - (unsigned int)(pc + opnd - codePtr->codeStart))); + (unsigned)(pc + opnd - codePtr->codeStart))); NEXT_INST_F(opnd, 0, 0); } @@ -3412,7 +3435,7 @@ TclExecuteByteCode( if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) { TRACE(("%d => %.20s true, new pc %u\n", jmpOffset[1], O2S(valuePtr), - (unsigned)(pc+jmpOffset[1] - codePtr->codeStart))); + (unsigned)(pc + jmpOffset[1] - codePtr->codeStart))); } else { TRACE(("%d => %.20s true\n", jmpOffset[0], O2S(valuePtr))); } @@ -3447,7 +3470,7 @@ TclExecuteByteCode( int jumpOffset = PTR2INT(Tcl_GetHashValue(hPtr)); TRACE_APPEND(("found in table, new pc %u\n", - (unsigned int)(pc - codePtr->codeStart + jumpOffset))); + (unsigned)(pc - codePtr->codeStart + jumpOffset))); NEXT_INST_F(jumpOffset, 1, 0); } else { TRACE_APPEND(("not found in table\n")); @@ -3538,7 +3561,7 @@ TclExecuteByteCode( /*** lindex with objc == 3 ***/ /* Variables also for INST_LIST_INDEX_IMM */ - + int listc, idx, opnd, pcAdjustment; Tcl_Obj **listv; Tcl_Obj *valuePtr, *value2Ptr; @@ -3556,8 +3579,9 @@ TclExecuteByteCode( result = TclListObjGetElements(interp, valuePtr, &listc, &listv); if ((result == TCL_OK) && (value2Ptr->typePtr != &tclListType) - && (TclGetIntForIndexM(NULL , value2Ptr, listc-1, &idx) == TCL_OK)) { - Tcl_DecrRefCount(value2Ptr); + && (TclGetIntForIndexM(NULL , value2Ptr, listc-1, + &idx) == TCL_OK)) { + TclDecrRefCount(value2Ptr); tosPtr--; pcAdjustment = 1; goto lindexFastPath; @@ -3579,7 +3603,7 @@ TclExecuteByteCode( goto checkForCatch; } - case INST_LIST_INDEX_IMM: + case INST_LIST_INDEX_IMM: /*** lindex with objc==3 and index in bytecode stream ***/ pcAdjustment = 5; @@ -3597,7 +3621,7 @@ TclExecuteByteCode( */ result = TclListObjGetElements(interp, valuePtr, &listc, &listv); - + if (result == TCL_OK) { /* * Select the list item based on the index. Negative operand means @@ -3731,7 +3755,7 @@ TclExecuteByteCode( */ objPtr = POP_OBJECT(); - Tcl_DecrRefCount(objPtr); /* This one should be done here */ + Tcl_DecrRefCount(objPtr); /* This one should be done here. */ /* * Get the new element value, and the index list. @@ -4246,11 +4270,13 @@ TclExecuteByteCode( if (match < 0) { objResultPtr = Tcl_GetObjResult(interp); - TRACE_WITH_OBJ(("%.20s %.20s => ERROR: ", O2S(valuePtr), O2S(value2Ptr)), objResultPtr); + TRACE_WITH_OBJ(("%.20s %.20s => ERROR: ", + O2S(valuePtr), O2S(value2Ptr)), objResultPtr); result = TCL_ERROR; goto checkForCatch; } else { - TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match)); + TRACE(("%.20s %.20s => %d\n", + O2S(valuePtr), O2S(value2Ptr), match)); objResultPtr = constants[match]; NEXT_INST_F(2, 2, 1); } @@ -4856,7 +4882,7 @@ TclExecuteByteCode( * Large left shifts create integer overflow. * * BEWARE! Can't use Tcl_GetIntFromObj() here because that - * converts values in the (unsigned int) range to their signed int + * converts values in the (unsigned) range to their signed int * counterparts, leading to incorrect results. */ @@ -5042,7 +5068,8 @@ TclExecuteByteCode( result = GetNumberFromObj(NULL, valuePtr, &ptr1, &type1); if ((result != TCL_OK) - || (type1 == TCL_NUMBER_NAN) || (type1 == TCL_NUMBER_DOUBLE)) { + || (type1 == TCL_NUMBER_NAN) + || (type1 == TCL_NUMBER_DOUBLE)) { result = TCL_ERROR; TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(valuePtr), O2S(value2Ptr), (valuePtr->typePtr? @@ -5446,14 +5473,14 @@ TclExecuteByteCode( NEXT_INST_F(1, 1, 0); } - /* TODO: Attempts to re-use unshared operands on stack */ + /* TODO: Attempts to re-use unshared operands on stack. */ if (*pc == INST_EXPON) { long l1 = 0, l2 = 0; Tcl_WideInt w1; int oddExponent = 0, negativeExponent = 0; if (type2 == TCL_NUMBER_LONG) { - l2 = *((const long *)ptr2); + l2 = *((const long *) ptr2); if (l2 == 0) { /* * Anything to the zero power is 1. @@ -5572,17 +5599,18 @@ TclExecuteByteCode( /* * Reduce small powers of 2 to shifts. */ - if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) { + + if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) { TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); TclNewLongObj(objResultPtr, (1L << l2)); TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } #if !defined(TCL_WIDE_INT_IS_LONG) - if ((unsigned long) l2 < CHAR_BIT * sizeof(Tcl_WideInt) - 1) { + if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); - objResultPtr - = Tcl_NewWideIntObj(((Tcl_WideInt) 1) << l2); + objResultPtr = + Tcl_NewWideIntObj(((Tcl_WideInt) 1) << l2); TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } @@ -5590,21 +5618,22 @@ TclExecuteByteCode( } if (l1 == -2) { int signum = oddExponent ? -1 : 1; + /* * Reduce small powers of 2 to shifts. */ - if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) { + + if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) { TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); TclNewLongObj(objResultPtr, signum * (1L << l2)); TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } #if !defined(TCL_WIDE_INT_IS_LONG) - if ((unsigned long) l2 < CHAR_BIT * sizeof(Tcl_WideInt) - 1) { + if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){ TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); - objResultPtr - = Tcl_NewWideIntObj(signum * - (((Tcl_WideInt) 1) << l2)); + objResultPtr = Tcl_NewWideIntObj( + signum * (((Tcl_WideInt) 1) << l2)); TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); } @@ -5612,36 +5641,37 @@ TclExecuteByteCode( } #if (LONG_MAX == 0x7fffffff) if (l2 <= 8 && - l1 <= MaxBase32[l2-2] && l1 >= -MaxBase32[l2-2]) { + l1 <= MaxBase32[l2-2] && l1 >= -MaxBase32[l2-2]) { /* - * Small powers of 32-bit integers + * Small powers of 32-bit integers. */ - long lResult = l1 * l1; /* b**2 */ + + long lResult = l1 * l1; /* b**2 */ switch (l2) { case 2: break; case 3: - lResult *= l1; /* b**3 */ + lResult *= l1; /* b**3 */ break; case 4: - lResult *= lResult; /* b**4 */ + lResult *= lResult; /* b**4 */ break; case 5: - lResult *= lResult; /* b**4 */ - lResult *= l1; /* b**5 */ + lResult *= lResult; /* b**4 */ + lResult *= l1; /* b**5 */ break; case 6: - lResult *= l1; /* b**3 */ - lResult *= lResult; /* b**6 */ + lResult *= l1; /* b**3 */ + lResult *= lResult; /* b**6 */ break; case 7: - lResult *= l1; /* b**3 */ - lResult *= lResult; /* b**6 */ - lResult *= l1; /* b**7 */ + lResult *= l1; /* b**3 */ + lResult *= lResult; /* b**6 */ + lResult *= l1; /* b**7 */ break; case 8: - lResult *= lResult; /* b**4 */ - lResult *= lResult; /* b**8 */ + lResult *= lResult; /* b**4 */ + lResult *= lResult; /* b**8 */ break; } TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); @@ -5654,16 +5684,17 @@ TclExecuteByteCode( TRACE(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 1, 0); } - if (l1 >= 3 - && (unsigned long) l1 < (sizeof(Exp32Index) - / sizeof(unsigned short)) - 1) { + if (l1 >= 3 && + ((unsigned long) l1 < (sizeof(Exp32Index) + / sizeof(unsigned short)) - 1)) { unsigned short base = Exp32Index[l1-3] - + (unsigned short) l2 - 9; + + (unsigned short) l2 - 9; if (base < Exp32Index[l1-2]) { /* - * 32-bit number raised to intermediate power, - * done by table lookup + * 32-bit number raised to intermediate power, done by + * table lookup. */ + TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); if (Tcl_IsShared(valuePtr)) { TclNewLongObj(objResultPtr, Exp32Value[base]); @@ -5681,12 +5712,14 @@ TclExecuteByteCode( unsigned short base = Exp32Index[-l1-3] + (unsigned short) l2 - 9; if (base < Exp32Index[-l1-2]) { - long lResult = (oddExponent) ? + long lResult = (oddExponent) ? -Exp32Value[base] : Exp32Value[base]; + /* - * 32-bit number raised to intermediate power, - * done by table lookup + * 32-bit number raised to intermediate power, done by + * table lookup. */ + TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); if (Tcl_IsShared(valuePtr)) { TclNewLongObj(objResultPtr, lResult); @@ -5710,83 +5743,84 @@ TclExecuteByteCode( w1 = 0; } #if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) - if (w1 != 0 && type2 == TCL_NUMBER_LONG - && l2 <= 16 - && w1 <= MaxBaseWide[l2-2] && w1 >= -MaxBaseWide[l2-2]) { - /* - * Small powers of integers whose result is wide + if (w1 != 0 && type2 == TCL_NUMBER_LONG && l2 <= 16 + && w1 <= MaxBaseWide[l2-2] && w1 >= -MaxBaseWide[l2-2]) { + /* + * Small powers of integers whose result is wide. */ + Tcl_WideInt wResult = w1 * w1; /* b**2 */ + switch (l2) { case 2: break; case 3: - wResult *= l1; /* b**3 */ + wResult *= l1; /* b**3 */ break; case 4: - wResult *= wResult; /* b**4 */ + wResult *= wResult; /* b**4 */ break; case 5: - wResult *= wResult; /* b**4 */ - wResult *= w1; /* b**5 */ + wResult *= wResult; /* b**4 */ + wResult *= w1; /* b**5 */ break; case 6: - wResult *= w1; /* b**3 */ - wResult *= wResult; /* b**6 */ + wResult *= w1; /* b**3 */ + wResult *= wResult; /* b**6 */ break; case 7: - wResult *= w1; /* b**3 */ - wResult *= wResult; /* b**6 */ - wResult *= w1; /* b**7 */ + wResult *= w1; /* b**3 */ + wResult *= wResult; /* b**6 */ + wResult *= w1; /* b**7 */ break; case 8: - wResult *= wResult; /* b**4 */ - wResult *= wResult; /* b**8 */ + wResult *= wResult; /* b**4 */ + wResult *= wResult; /* b**8 */ break; case 9: - wResult *= wResult; /* b**4 */ - wResult *= wResult; /* b**8 */ - wResult *= w1; /* b**9 */ + wResult *= wResult; /* b**4 */ + wResult *= wResult; /* b**8 */ + wResult *= w1; /* b**9 */ break; case 10: - wResult *= wResult; /* b**4 */ - wResult *= w1; /* b**5 */ + wResult *= wResult; /* b**4 */ + wResult *= w1; /* b**5 */ wResult *= wResult; /* b**10 */ break; case 11: - wResult *= wResult; /* b**4 */ - wResult *= w1; /* b**5 */ + wResult *= wResult; /* b**4 */ + wResult *= w1; /* b**5 */ wResult *= wResult; /* b**10 */ - wResult *= w1; /* b**11 */ + wResult *= w1; /* b**11 */ break; case 12: - wResult *= w1; /* b**3 */ - wResult *= wResult; /* b**6 */ - wResult *= wResult; /* b**12 */ + wResult *= w1; /* b**3 */ + wResult *= wResult; /* b**6 */ + wResult *= wResult; /* b**12 */ break; case 13: - wResult *= w1; /* b**3 */ - wResult *= wResult; /* b**6 */ - wResult *= wResult; /* b**12 */ - wResult *= w1; /* b**13 */ + wResult *= w1; /* b**3 */ + wResult *= wResult; /* b**6 */ + wResult *= wResult; /* b**12 */ + wResult *= w1; /* b**13 */ break; case 14: - wResult *= w1; /* b**3 */ - wResult *= wResult; /* b**6 */ - wResult *= w1; /* b**7 */ + wResult *= w1; /* b**3 */ + wResult *= wResult; /* b**6 */ + wResult *= w1; /* b**7 */ wResult *= wResult; /* b**14 */ break; case 15: - wResult *= w1; /* b**3 */ - wResult *= wResult; /* b**6 */ - wResult *= w1; /* b**7 */ + wResult *= w1; /* b**3 */ + wResult *= wResult; /* b**6 */ + wResult *= w1; /* b**7 */ wResult *= wResult; /* b**14 */ - wResult *= w1; /* b**15 */ + wResult *= w1; /* b**15 */ break; case 16: - wResult *= wResult; /* b**4 */ - wResult *= wResult; /* b**8 */ - wResult *= wResult; /* b**16 */ + wResult *= wResult; /* b**4 */ + wResult *= wResult; /* b**8 */ + wResult *= wResult; /* b**16 */ break; } @@ -5797,19 +5831,22 @@ TclExecuteByteCode( } /* - * Handle cases of powers > 16 that still fit in a 64-bit - * word by doing table lookup + * Handle cases of powers > 16 that still fit in a 64-bit word by + * doing table lookup. */ - if (w1 >= 3 - && (Tcl_WideUInt) w1 < (sizeof(Exp64Index) - / sizeof(unsigned short)) - 1) { - unsigned short base - = Exp64Index[w1-3] + (unsigned short) l2 - 17; + + if (w1 >= 3 && + (Tcl_WideUInt) w1 < (sizeof(Exp64Index) + / sizeof(unsigned short)) - 1) { + unsigned short base = + Exp64Index[w1-3] + (unsigned short) l2 - 17; + if (base < Exp64Index[w1-2]) { /* - * 64-bit number raised to intermediate power, - * done by table lookup + * 64-bit number raised to intermediate power, done by + * table lookup. */ + TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); if (Tcl_IsShared(valuePtr)) { objResultPtr = Tcl_NewWideIntObj(Exp64Value[base]); @@ -5821,18 +5858,20 @@ TclExecuteByteCode( NEXT_INST_F(1, 1, 0); } } - if (-w1 >= 3 - && (Tcl_WideUInt) (-w1) < (sizeof(Exp64Index) - / sizeof(unsigned short)) - 1) { - unsigned short base - = Exp64Index[-w1-3] + (unsigned short) l2 - 17; + if (-w1 >= 3 && + (Tcl_WideUInt) (-w1) < (sizeof(Exp64Index) + / sizeof(unsigned short)) - 1) { + unsigned short base = + Exp64Index[-w1-3] + (unsigned short) l2 - 17; + if (base < Exp64Index[-w1-2]) { - Tcl_WideInt wResult = (oddExponent) ? - -Exp64Value[base] : Exp64Value[base]; + Tcl_WideInt wResult = (oddExponent) ? + -Exp64Value[base] : Exp64Value[base]; /* - * 64-bit number raised to intermediate power, - * done by table lookup + * 64-bit number raised to intermediate power, done by + * table lookup. */ + TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); if (Tcl_IsShared(valuePtr)) { objResultPtr = Tcl_NewWideIntObj(wResult); @@ -5845,13 +5884,14 @@ TclExecuteByteCode( } } #endif - + goto overflow; } if ((*pc != INST_MULT) && (type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) { Tcl_WideInt w1, w2, wResult; + TclGetWideIntFromObj(NULL, valuePtr, &w1); TclGetWideIntFromObj(NULL, value2Ptr, &w2); @@ -5881,12 +5921,12 @@ TclExecuteByteCode( /* * Must check for overflow. The macro tests for overflows * in sums by looking at the sign bits. As we have a - * subtraction here, we are adding -w2. As -w2 could in turn - * overflow, we test with ~w2 instead: it has the opposite - * sign bit to w2 so it does the job. Note that the only - * "bad" case (w2==0) is irrelevant for this macro, as in - * that case w1 and wResult have the same sign and there - * is no overflow anyway. + * subtraction here, we are adding -w2. As -w2 could in + * turn overflow, we test with ~w2 instead: it has the + * opposite sign bit to w2 so it does the job. Note that + * the only "bad" case (w2==0) is irrelevant for this + * macro, as in that case w1 and wResult have the same + * sign and there is no overflow anyway. */ if (Overflowing(w1, ~w2, wResult)) { @@ -6058,6 +6098,7 @@ TclExecuteByteCode( #ifndef NO_WIDE_TYPE if (type == TCL_NUMBER_WIDE) { Tcl_WideInt w = *((const Tcl_WideInt *)ptr); + if (Tcl_IsShared(valuePtr)) { objResultPtr = Tcl_NewWideIntObj(~w); NEXT_INST_F(1, 1, 1); @@ -6109,6 +6150,7 @@ TclExecuteByteCode( } case TCL_NUMBER_LONG: { long l = *((const long *)ptr); + if (l != LONG_MIN) { if (Tcl_IsShared(valuePtr)) { TclNewLongObj(objResultPtr, -l); @@ -6320,12 +6362,11 @@ TclExecuteByteCode( * the next value list element to each loop var. */ - int opnd, numLists; ForeachInfo *infoPtr; ForeachVarList *varListPtr; Tcl_Obj *listPtr,*valuePtr, *value2Ptr, **elements; Var *iterVarPtr, *listVarPtr, *varPtr; - int iterNum, listTmpIndex, listLen, numVars; + int opnd, numLists, iterNum, listTmpIndex, listLen, numVars; int varIndex, valIndex, continueLoop, j; long i; @@ -6419,13 +6460,13 @@ TclExecuteByteCode( "%u => ERROR init. index temp %d: ", opnd,varIndex), Tcl_GetObjResult(interp)); result = TCL_ERROR; - Tcl_DecrRefCount(listPtr); + TclDecrRefCount(listPtr); goto checkForCatch; } } valIndex++; } - Tcl_DecrRefCount(listPtr); + TclDecrRefCount(listPtr); listTmpIndex++; } } @@ -6548,7 +6589,7 @@ TclExecuteByteCode( dictPtr = varPtr->value.objPtr; } else { DECACHE_STACK_INFO(); - dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd2); + dictPtr = TclPtrGetVar(interp, varPtr, NULL,NULL,NULL, 0, opnd2); CACHE_STACK_INFO(); } if (dictPtr == NULL) { @@ -6588,7 +6629,7 @@ TclExecuteByteCode( if (result == TCL_OK) { Tcl_InvalidateStringRep(dictPtr); } - Tcl_DecrRefCount(incrPtr); + TclDecrRefCount(incrPtr); } break; case INST_DICT_UNSET: @@ -6603,7 +6644,7 @@ TclExecuteByteCode( if (result != TCL_OK) { if (allocateDict) { - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); } TRACE_WITH_OBJ(("%u %u => ERROR updating dictionary: ", opnd, opnd2), Tcl_GetObjResult(interp)); @@ -6616,7 +6657,7 @@ TclExecuteByteCode( Tcl_IncrRefCount(dictPtr); if (oldValuePtr != NULL) { - Tcl_DecrRefCount(oldValuePtr); + TclDecrRefCount(oldValuePtr); } varPtr->value.objPtr = dictPtr; } @@ -6627,7 +6668,7 @@ TclExecuteByteCode( objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL, dictPtr, TCL_LEAVE_ERR_MSG, opnd2); CACHE_STACK_INFO(); - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); if (objResultPtr == NULL) { TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); @@ -6672,7 +6713,7 @@ TclExecuteByteCode( result = Tcl_DictObjGet(interp, dictPtr, OBJ_UNDER_TOS, &valPtr); if (result != TCL_OK) { if (allocateDict) { - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); } goto checkForCatch; } @@ -6705,9 +6746,9 @@ TclExecuteByteCode( valPtr = Tcl_DuplicateObj(valPtr); result = Tcl_ListObjAppendElement(interp, valPtr, OBJ_AT_TOS); if (result != TCL_OK) { - Tcl_DecrRefCount(valPtr); + TclDecrRefCount(valPtr); if (allocateDict) { - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); } goto checkForCatch; } @@ -6715,7 +6756,7 @@ TclExecuteByteCode( result = Tcl_ListObjAppendElement(interp, valPtr, OBJ_AT_TOS); if (result != TCL_OK) { if (allocateDict) { - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); } goto checkForCatch; } @@ -6733,7 +6774,7 @@ TclExecuteByteCode( Tcl_IncrRefCount(dictPtr); if (oldValuePtr != NULL) { - Tcl_DecrRefCount(oldValuePtr); + TclDecrRefCount(oldValuePtr); } varPtr->value.objPtr = dictPtr; } @@ -6744,7 +6785,7 @@ TclExecuteByteCode( objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL, dictPtr, TCL_LEAVE_ERR_MSG, opnd); CACHE_STACK_INFO(); - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); if (objResultPtr == NULL) { TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); @@ -6785,7 +6826,7 @@ TclExecuteByteCode( varPtr = (compiledLocals + opnd); if (varPtr->value.objPtr) { if (varPtr->value.objPtr->typePtr != &dictIteratorType) { - Tcl_DecrRefCount(varPtr->value.objPtr); + TclDecrRefCount(varPtr->value.objPtr); } else { Tcl_Panic("mis-issued dictFirst!"); } @@ -6838,14 +6879,14 @@ TclExecuteByteCode( ckfree((char *) searchPtr); dictPtr = (Tcl_Obj *) statePtr->internalRep.twoPtrValue.ptr2; - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); /* * Set the internal variable to an empty object to signify that we * don't hold an iterator. */ - Tcl_DecrRefCount(statePtr); + TclDecrRefCount(statePtr); TclNewObj(emptyPtr); compiledLocals[opnd].value.objPtr = emptyPtr; Tcl_IncrRefCount(emptyPtr); @@ -6970,7 +7011,7 @@ TclExecuteByteCode( } if (TclIsVarDirectWritable(varPtr)) { Tcl_IncrRefCount(dictPtr); - Tcl_DecrRefCount(varPtr->value.objPtr); + TclDecrRefCount(varPtr->value.objPtr); varPtr->value.objPtr = dictPtr; } else { DECACHE_STACK_INFO(); @@ -6979,7 +7020,7 @@ TclExecuteByteCode( CACHE_STACK_INFO(); if (objResultPtr == NULL) { if (allocdict) { - Tcl_DecrRefCount(dictPtr); + TclDecrRefCount(dictPtr); } result = TCL_ERROR; goto checkForCatch; @@ -7087,7 +7128,8 @@ TclExecuteByteCode( NEXT_INST_F(0, 0, 0); } else { if (rangePtr->continueOffset == -1) { - TRACE_APPEND(("%s, loop w/o continue, checking for catch\n", + TRACE_APPEND(( + "%s, loop w/o continue, checking for catch\n", StringForResultCode(result))); goto checkForCatch; } @@ -7176,6 +7218,7 @@ TclExecuteByteCode( * script to INST_EVAL. Cannot correct the compiler without * breakingcompat with previous .tbc compiled scripts. */ + #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { fprintf(stdout, " ... no enclosing catch, returning %s\n", @@ -7193,21 +7236,21 @@ TclExecuteByteCode( * had when starting to execute the range's catch command. */ - processCatch: + processCatch: while (CURR_DEPTH > *catchTop) { valuePtr = POP_OBJECT(); TclDecrRefCount(valuePtr); } #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { - fprintf(stdout, " ... found catch at %d, catchTop=%d, unwound to %ld, new pc %u\n", - rangePtr->codeOffset, (catchTop - initCatchTop - 1), - (long) *catchTop, - (unsigned int)(rangePtr->catchOffset)); + fprintf(stdout, " ... found catch at %d, catchTop=%d, " + "unwound to %ld, new pc %u\n", + rangePtr->codeOffset, catchTop - initCatchTop - 1, + (long) *catchTop, (unsigned) rangePtr->catchOffset); } #endif pc = (codePtr->codeStart + rangePtr->catchOffset); - NEXT_INST_F(0, 0, 0); /* restart the execution loop at pc */ + NEXT_INST_F(0, 0, 0); /* Restart the execution loop at pc. */ /* * end of infinite loop dispatching on instructions. @@ -7219,30 +7262,31 @@ TclExecuteByteCode( * initial level. */ - abnormalReturn: - { - TCL_DTRACE_INST_LAST(); - while (tosPtr > initTosPtr) { - Tcl_Obj *objPtr = POP_OBJECT(); - Tcl_DecrRefCount(objPtr); - } + abnormalReturn: + TCL_DTRACE_INST_LAST(); + while (tosPtr > initTosPtr) { + Tcl_Obj *objPtr = POP_OBJECT(); - /* - * Clear all expansions. - */ + Tcl_DecrRefCount(objPtr); + } - while (expandNestList) { - Tcl_Obj *objPtr = expandNestList->internalRep.twoPtrValue.ptr2; - TclDecrRefCount(expandNestList); - expandNestList = objPtr; - } - if (tosPtr < initTosPtr) { - fprintf(stderr, "\nTclExecuteByteCode: abnormal return at pc %u: stack top %d < entry stack top %d\n", - (unsigned int)(pc - codePtr->codeStart), - (unsigned int) CURR_DEPTH, - (unsigned int) 0); - Tcl_Panic("TclExecuteByteCode execution failure: end stack top < start stack top"); - } + /* + * Clear all expansions. + */ + + while (expandNestList) { + Tcl_Obj *objPtr = expandNestList->internalRep.twoPtrValue.ptr2; + + TclDecrRefCount(expandNestList); + expandNestList = objPtr; + } + if (tosPtr < initTosPtr) { + fprintf(stderr, + "\nTclExecuteByteCode: abnormal return at pc %u: " + "stack top %d < entry stack top %d\n", + (unsigned)(pc - codePtr->codeStart), + (unsigned) CURR_DEPTH, (unsigned) 0); + Tcl_Panic("TclExecuteByteCode execution failure: end stack top < start stack top"); } } @@ -7295,17 +7339,17 @@ PrintByteCodeInfo( codePtr->numAuxDataItems, codePtr->maxStackDepth, #ifdef TCL_COMPILE_STATS codePtr->numSrcBytes? - ((float)codePtr->structureSize)/codePtr->numSrcBytes : + ((float)codePtr->structureSize)/codePtr->numSrcBytes : #endif 0.0); #ifdef TCL_COMPILE_STATS fprintf(stdout, " Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n", (unsigned long) codePtr->structureSize, - (unsigned long) (sizeof(ByteCode) - (sizeof(size_t) + sizeof(Tcl_Time))), + (unsigned long) (sizeof(ByteCode)-sizeof(size_t)-sizeof(Tcl_Time)), codePtr->numCodeBytes, (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)), - (unsigned long) (codePtr->numExceptRanges * sizeof(ExceptionRange)), + (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)), (unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)), codePtr->numCmdLocBytes); #endif /* TCL_COMPILE_STATS */ @@ -7353,7 +7397,7 @@ ValidatePcAndStackTop( { int stackUpperBound = stackLowerBound + codePtr->maxStackDepth; /* Greatest legal value for stackTop. */ - unsigned int relativePc = (unsigned int) (pc - codePtr->codeStart); + unsigned relativePc = (unsigned) (pc - codePtr->codeStart); unsigned long codeStart = (unsigned long) codePtr->codeStart; unsigned long codeEnd = (unsigned long) (codePtr->codeStart + codePtr->numCodeBytes); @@ -7364,9 +7408,9 @@ ValidatePcAndStackTop( pc); Tcl_Panic("TclExecuteByteCode execution failure: bad pc"); } - if ((unsigned int) opCode > LAST_INST_OPCODE) { + if ((unsigned) opCode > LAST_INST_OPCODE) { fprintf(stderr, "\nBad opcode %d at pc %u in TclExecuteByteCode\n", - (unsigned int) opCode, relativePc); + (unsigned) opCode, relativePc); Tcl_Panic("TclExecuteByteCode execution failure: bad opcode"); } if (checkStack && @@ -7583,7 +7627,7 @@ GetSrcInfoForPc( srcLengthNext = codePtr->srcLengthStart; codeOffset = srcOffset = 0; for (i = 0; i < numCmds; i++) { - if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) { + if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) { codeDeltaNext++; delta = TclGetInt4AtPtr(codeDeltaNext); codeDeltaNext += 4; @@ -7593,7 +7637,7 @@ GetSrcInfoForPc( } codeOffset += delta; - if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) { + if ((unsigned) *codeLengthNext == (unsigned) 0xFF) { codeLengthNext++; codeLen = TclGetInt4AtPtr(codeLengthNext); codeLengthNext += 4; @@ -7603,7 +7647,7 @@ GetSrcInfoForPc( } codeEnd = (codeOffset + codeLen - 1); - if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) { + if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) { srcDeltaNext++; delta = TclGetInt4AtPtr(srcDeltaNext); srcDeltaNext += 4; @@ -7613,7 +7657,7 @@ GetSrcInfoForPc( } srcOffset += delta; - if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) { + if ((unsigned) *srcLengthNext == (unsigned) 0xFF) { srcLengthNext++; srcLen = TclGetInt4AtPtr(srcLengthNext); srcLengthNext += 4; @@ -7686,7 +7730,7 @@ GetExceptRangeForPc( ExceptionRange *rangeArrayPtr; int numRanges = codePtr->numExceptRanges; register ExceptionRange *rangePtr; - int pcOffset = (pc - codePtr->codeStart); + int pcOffset = pc - codePtr->codeStart; register int start; if (numRanges == 0) { @@ -7866,6 +7910,8 @@ EvalStatsCmd( char *litTableStats; LiteralEntry *entryPtr; +#define Percent(a,b) ((a) * 100.0 / (b)) + numInstructions = 0.0; for (i = 0; i < 256; i++) { if (statsPtr->instructionCount[i] != 0) { @@ -7883,7 +7929,7 @@ EvalStatsCmd( numCurrentByteCodes = statsPtr->numCompilations - statsPtr->numByteCodesFreed; currentHeaderBytes = numCurrentByteCodes - * (sizeof(ByteCode) - (sizeof(size_t) + sizeof(Tcl_Time))); + * (sizeof(ByteCode) - sizeof(size_t) - sizeof(Tcl_Time)); literalMgmtBytes = sizeof(LiteralTable) + (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)) + (iPtr->literalTable.numEntries * sizeof(LiteralEntry)); @@ -7906,7 +7952,7 @@ EvalStatsCmd( fprintf(stdout, "Number ByteCodes compiled %ld\n", statsPtr->numCompilations); fprintf(stdout, " Mean executions/compile %.1f\n", - ((float)statsPtr->numExecutions) / statsPtr->numCompilations); + statsPtr->numExecutions / (float)statsPtr->numCompilations); fprintf(stdout, "\nInstructions executed %.0f\n", numInstructions); @@ -8023,21 +8069,21 @@ EvalStatsCmd( fprintf(stdout, "\nCurrent literal objects %d (%0.1f%% of current objects)\n", globalTablePtr->numEntries, - (globalTablePtr->numEntries * 100.0) / (tclObjsAlloced-tclObjsFreed)); + Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed)); fprintf(stdout, " ByteCode literals %ld (%0.1f%% of current literals)\n", numByteCodeLits, - (numByteCodeLits * 100.0) / globalTablePtr->numEntries); + Percent(numByteCodeLits, globalTablePtr->numEntries)); fprintf(stdout, " Literals reused > 1x %d\n", numSharedMultX); fprintf(stdout, " Mean reference count %.2f\n", ((double) refCountSum) / globalTablePtr->numEntries); fprintf(stdout, " Mean len, str reused >1x %.2f\n", - (numSharedMultX? (strBytesSharedMultX/numSharedMultX) : 0.0)); + (numSharedMultX ? strBytesSharedMultX/numSharedMultX : 0.0)); fprintf(stdout, " Mean len, str used 1x %.2f\n", - (numSharedOnce? (strBytesSharedOnce/numSharedOnce) : 0.0)); + (numSharedOnce ? strBytesSharedOnce/numSharedOnce : 0.0)); fprintf(stdout, " Total sharing savings %.6g (%0.1f%% of bytes if no sharing)\n", sharingBytesSaved, - (sharingBytesSaved * 100.0) / (objBytesIfUnshared + strBytesIfUnshared)); + Percent(sharingBytesSaved, objBytesIfUnshared+strBytesIfUnshared)); fprintf(stdout, " Bytes with sharing %.6g\n", currentLiteralBytes); fprintf(stdout, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n", @@ -8054,7 +8100,7 @@ EvalStatsCmd( strBytesIfUnshared, statsPtr->currentLitStringBytes); fprintf(stdout, " Literal mgmt overhead %ld (%0.1f%% of bytes with sharing)\n", literalMgmtBytes, - (literalMgmtBytes * 100.0) / currentLiteralBytes); + Percent(literalMgmtBytes, currentLiteralBytes)); fprintf(stdout, " table %lu + buckets %lu + entries %lu\n", (unsigned long) sizeof(LiteralTable), (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)), @@ -8072,27 +8118,27 @@ EvalStatsCmd( statsPtr->currentByteCodeBytes / numCurrentByteCodes); fprintf(stdout, "Header %12.6g %8.1f%% %8.1f\n", currentHeaderBytes, - (currentHeaderBytes * 100.0) / statsPtr->currentByteCodeBytes, + Percent(currentHeaderBytes, statsPtr->currentByteCodeBytes), currentHeaderBytes / numCurrentByteCodes); fprintf(stdout, "Instructions %12.6g %8.1f%% %8.1f\n", statsPtr->currentInstBytes, - (statsPtr->currentInstBytes*100.0)/statsPtr->currentByteCodeBytes, + Percent(statsPtr->currentInstBytes,statsPtr->currentByteCodeBytes), statsPtr->currentInstBytes / numCurrentByteCodes); fprintf(stdout, "Literal ptr array %12.6g %8.1f%% %8.1f\n", statsPtr->currentLitBytes, - (statsPtr->currentLitBytes*100.0)/statsPtr->currentByteCodeBytes, + Percent(statsPtr->currentLitBytes,statsPtr->currentByteCodeBytes), statsPtr->currentLitBytes / numCurrentByteCodes); fprintf(stdout, "Exception table %12.6g %8.1f%% %8.1f\n", statsPtr->currentExceptBytes, - (statsPtr->currentExceptBytes*100.0)/statsPtr->currentByteCodeBytes, + Percent(statsPtr->currentExceptBytes,statsPtr->currentByteCodeBytes), statsPtr->currentExceptBytes / numCurrentByteCodes); fprintf(stdout, "Auxiliary data %12.6g %8.1f%% %8.1f\n", statsPtr->currentAuxBytes, - (statsPtr->currentAuxBytes*100.0)/statsPtr->currentByteCodeBytes, + Percent(statsPtr->currentAuxBytes,statsPtr->currentByteCodeBytes), statsPtr->currentAuxBytes / numCurrentByteCodes); fprintf(stdout, "Command map %12.6g %8.1f%% %8.1f\n", statsPtr->currentCmdMapBytes, - (statsPtr->currentCmdMapBytes*100.0)/statsPtr->currentByteCodeBytes, + Percent(statsPtr->currentCmdMapBytes,statsPtr->currentByteCodeBytes), statsPtr->currentCmdMapBytes / numCurrentByteCodes); /* @@ -8113,7 +8159,7 @@ EvalStatsCmd( decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->literalCount[i]; fprintf(stdout, " %10d %8.0f%%\n", - decadeHigh, (sum * 100.0) / statsPtr->numLiteralsCreated); + decadeHigh, Percent(sum, statsPtr->numLiteralsCreated)); } litTableStats = TclLiteralStats(globalTablePtr); @@ -8145,7 +8191,7 @@ EvalStatsCmd( decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->srcCount[i]; fprintf(stdout, " %10d %8.0f%%\n", - decadeHigh, (sum * 100.0) / statsPtr->numCompilations); + decadeHigh, Percent(sum, statsPtr->numCompilations)); } fprintf(stdout, "\nByteCode sizes:\n"); @@ -8168,7 +8214,7 @@ EvalStatsCmd( decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->byteCodeCount[i]; fprintf(stdout, " %10d %8.0f%%\n", - decadeHigh, (sum * 100.0) / statsPtr->numCompilations); + decadeHigh, Percent(sum, statsPtr->numCompilations)); } fprintf(stdout, "\nByteCode longevity (excludes Current ByteCodes):\n"); @@ -8191,8 +8237,7 @@ EvalStatsCmd( decadeHigh = (1 << (i+1)) - 1; sum += statsPtr->lifetimeCount[i]; fprintf(stdout, " %12.3f %8.0f%%\n", - decadeHigh / 1000.0, - (sum * 100.0) / statsPtr->numByteCodesFreed); + decadeHigh/1000.0, Percent(sum, statsPtr->numByteCodesFreed)); } /* @@ -8201,11 +8246,11 @@ EvalStatsCmd( fprintf(stdout, "\nInstruction counts:\n"); for (i = 0; i <= LAST_INST_OPCODE; i++) { - if (statsPtr->instructionCount[i]) { + if (statsPtr->instructionCount[i] == 0) { fprintf(stdout, "%20s %8ld %6.1f%%\n", tclInstructionTable[i].name, statsPtr->instructionCount[i], - (statsPtr->instructionCount[i]*100.0) / numInstructions); + Percent(statsPtr->instructionCount[i], numInstructions)); } } |