summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclCompile.c34
-rw-r--r--generic/tclExecute.c547
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));
}
}