summaryrefslogtreecommitdiffstats
path: root/generic/tclExecute.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r--generic/tclExecute.c219
1 files changed, 126 insertions, 93 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 411cb8b..37a7397 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2220,41 +2220,41 @@ TEBCresume(
codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
}
- if (result == TCL_OK) {
- /*
- * Push the call's object result and continue execution with the
- * next instruction.
- */
+ if (result != TCL_OK) {
+ pc--;
+ goto processExceptionReturn;
+ }
- TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
- objc, cmdNameBuf), Tcl_GetObjResult(interp));
+ /*
+ * Push the call's object result and continue execution with the next
+ * instruction.
+ */
- /*
- * Reset the interp's result to avoid possible duplications of
- * large objects [Bug 781585]. We do not call Tcl_ResetResult to
- * avoid any side effects caused by the resetting of errorInfo and
- * errorCode [Bug 804681], which are not needed here. We chose
- * instead to manipulate the interp's object result directly.
- *
- * Note that the result object is now in objResultPtr, it keeps
- * the refCount it had in its role of iPtr->objResultPtr.
- */
+ TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
+ objc, cmdNameBuf), Tcl_GetObjResult(interp));
+
+ /*
+ * Reset the interp's result to avoid possible duplications of large
+ * objects [Bug 781585]. We do not call Tcl_ResetResult to avoid any
+ * side effects caused by the resetting of errorInfo and errorCode
+ * [Bug 804681], which are not needed here. We chose instead to
+ * manipulate the interp's object result directly.
+ *
+ * Note that the result object is now in objResultPtr, it keeps the
+ * refCount it had in its role of iPtr->objResultPtr.
+ */
- objResultPtr = Tcl_GetObjResult(interp);
- TclNewObj(objPtr);
- Tcl_IncrRefCount(objPtr);
- iPtr->objResultPtr = objPtr;
+ objResultPtr = Tcl_GetObjResult(interp);
+ TclNewObj(objPtr);
+ Tcl_IncrRefCount(objPtr);
+ iPtr->objResultPtr = objPtr;
#ifndef TCL_COMPILE_DEBUG
- if (*pc == INST_POP) {
- TclDecrRefCount(objResultPtr);
- NEXT_INST_V(1, cleanup, 0);
- }
-#endif
- NEXT_INST_V(0, cleanup, -1);
- } else {
- pc--;
- goto processExceptionReturn;
+ if (*pc == INST_POP) {
+ TclDecrRefCount(objResultPtr);
+ NEXT_INST_V(1, cleanup, 0);
}
+#endif
+ NEXT_INST_V(0, cleanup, -1);
}
/*
@@ -2474,8 +2474,10 @@ TEBCresume(
TRACE_APPEND(("ERROR: yield outside coroutine\n"));
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"yield can only be called in a coroutine", -1));
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
NULL);
+ CACHE_STACK_INFO();
goto gotError;
}
@@ -2520,7 +2522,9 @@ TEBCresume(
TRACE(("%d => ERROR: tailcall in non-proc context\n", opnd));
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"tailcall can only be called from a proc or lambda", -1));
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
+ CACHE_STACK_INFO();
goto gotError;
}
@@ -2598,7 +2602,7 @@ TEBCresume(
case INST_OVER:
opnd = TclGetUInt4AtPtr(pc+1);
objResultPtr = OBJ_AT_DEPTH(opnd);
- TRACE_WITH_OBJ(("=> "), objResultPtr);
+ TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
NEXT_INST_F(5, 0, 1);
case INST_REVERSE: {
@@ -2613,6 +2617,7 @@ TEBCresume(
*b = tmpPtr;
a++; b--;
}
+ TRACE(("%u => OK\n", opnd));
NEXT_INST_F(5, 0, 0);
}
@@ -2783,6 +2788,7 @@ TEBCresume(
objPtr->internalRep.ptrAndLongRep.value = CURR_DEPTH;
objPtr->length = 0;
PUSH_TAUX_OBJ(objPtr);
+ TRACE(("=> mark depth as %d\n", (int) CURR_DEPTH));
NEXT_INST_F(1, 0, 0);
case INST_EXPAND_DROP:
@@ -2799,6 +2805,7 @@ TEBCresume(
/* Ugly abuse! */
starting = 1;
#endif
+ TRACE(("=> drop %d items\n", objc));
NEXT_INST_V(1, objc, 0);
case INST_EXPAND_STKTOP: {
@@ -3578,8 +3585,10 @@ TEBCresume(
varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr,
TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr);
if (!varPtr) {
+ DECACHE_STACK_INFO();
Tcl_AddErrorInfo(interp,
"\n (reading value of variable to increment)");
+ CACHE_STACK_INFO();
TRACE_ERROR(interp);
Tcl_DecrRefCount(incrPtr);
goto gotError;
@@ -3897,7 +3906,7 @@ TEBCresume(
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
- TRACE(("%s %u => ", (flags?"normal":"noerr"), opnd));
+ TRACE(("%s %u => ", (flags ? "normal" : "noerr"), opnd));
if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
/*
* No errors, no traces, no searches: just make the variable cease
@@ -3978,7 +3987,7 @@ TEBCresume(
cleanup = 2;
part2Ptr = OBJ_AT_TOS; /* element name */
part1Ptr = OBJ_UNDER_TOS; /* array name */
- TRACE(("%s \"%.30s(%.30s)\" => ", (flags?"normal":"noerr"),
+ TRACE(("%s \"%.30s(%.30s)\" => ", (flags ? "normal" : "noerr"),
O2S(part1Ptr), O2S(part2Ptr)));
goto doUnsetStk;
@@ -3987,7 +3996,8 @@ TEBCresume(
cleanup = 1;
part2Ptr = NULL;
part1Ptr = OBJ_AT_TOS; /* variable name */
- TRACE(("%s \"%.30s\" => ", (flags?"normal":"noerr"), O2S(part1Ptr)));
+ TRACE(("%s \"%.30s\" => ", (flags ? "normal" : "noerr"),
+ O2S(part1Ptr)));
doUnsetStk:
DECACHE_STACK_INFO();
@@ -4010,7 +4020,7 @@ TEBCresume(
case INST_DICT_DONE:
opnd = TclGetUInt4AtPtr(pc+1);
- TRACE(("%u\n", opnd));
+ TRACE(("%u => OK\n", opnd));
varPtr = LOCAL(opnd);
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
@@ -4108,7 +4118,9 @@ TEBCresume(
TclObjVarErrMsg(interp, part1Ptr, NULL, "array set",
"variable isn't array", opnd);
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
+ CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
}
@@ -4447,8 +4459,10 @@ TEBCresume(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad level \"%s\"", TclGetString(OBJ_AT_TOS)));
TRACE_ERROR(interp);
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL",
TclGetString(OBJ_AT_TOS), NULL);
+ CACHE_STACK_INFO();
goto gotError;
}
objResultPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv);
@@ -4475,7 +4489,9 @@ TEBCresume(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"self may only be called from inside a method",
-1));
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ CACHE_STACK_INFO();
goto gotError;
}
contextPtr = framePtr->clientData;
@@ -5024,16 +5040,15 @@ TEBCresume(
}
}
- TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr),
- (match < 0 ? -1 : match > 0 : 1 : 0)));
-
+ TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
+ (match < 0 ? -1 : match > 0 ? 1 : 0)));
JUMP_PEEPHOLE_F(match, 1, 2);
case INST_STR_LEN:
valuePtr = OBJ_AT_TOS;
length = Tcl_GetCharLength(valuePtr);
TclNewIntObj(objResultPtr, length);
- TRACE(("%.20s => %d\n", O2S(valuePtr), length));
+ TRACE(("\"%.20s\" => %d\n", O2S(valuePtr), length));
NEXT_INST_F(1, 1, 1);
case INST_STR_INDEX:
@@ -5150,27 +5165,27 @@ TEBCresume(
value2Ptr = OBJ_AT_DEPTH(2); /* "Source" string. */
if (value3Ptr == value2Ptr) {
objResultPtr = valuePtr;
- NEXT_INST_V(1, 3, 1);
+ goto doneStringMap;
} else if (valuePtr == value2Ptr) {
objResultPtr = value3Ptr;
- NEXT_INST_V(1, 3, 1);
+ goto doneStringMap;
}
ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
if (length == 0) {
objResultPtr = valuePtr;
- NEXT_INST_V(1, 3, 1);
+ goto doneStringMap;
}
ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
if (length2 > length || length2 == 0) {
objResultPtr = valuePtr;
- NEXT_INST_V(1, 3, 1);
+ goto doneStringMap;
} else if (length2 == length) {
if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) {
objResultPtr = valuePtr;
} else {
objResultPtr = value3Ptr;
}
- NEXT_INST_V(1, 3, 1);
+ goto doneStringMap;
}
ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3);
@@ -5199,6 +5214,7 @@ TEBCresume(
Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p);
}
+ doneStringMap:
TRACE_WITH_OBJ(("%.20s %.20s %.20s => ",
O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr);
NEXT_INST_V(1, 3, 1);
@@ -5221,7 +5237,6 @@ TEBCresume(
TRACE(("%.20s %.20s => %d\n",
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
-
TclNewIntObj(objResultPtr, match);
NEXT_INST_F(1, 2, 1);
@@ -5293,6 +5308,7 @@ TEBCresume(
cflags = TclGetInt1AtPtr(pc+1); /* RE compile flages like NOCASE */
valuePtr = OBJ_AT_TOS; /* String */
value2Ptr = OBJ_UNDER_TOS; /* Pattern */
+ TRACE(("%.20s %.20s => ", O2S(valuePtr), O2S(value2Ptr)));
/*
* Compile and match the regular expression.
@@ -5303,23 +5319,17 @@ TEBCresume(
Tcl_GetRegExpFromObj(interp, value2Ptr, cflags);
if (regExpr == NULL) {
- goto regexpFailure;
+ TRACE_ERROR(interp);
+ goto gotError;
}
-
match = Tcl_RegExpExecObj(interp, regExpr, valuePtr, 0, 0, 0);
-
if (match < 0) {
- regexpFailure:
-#ifdef TCL_COMPILE_DEBUG
- objResultPtr = Tcl_GetObjResult(interp);
- TRACE_WITH_OBJ(("%.20s %.20s => ERROR: ",
- O2S(valuePtr), O2S(value2Ptr)), objResultPtr);
-#endif
+ TRACE_ERROR(interp);
goto gotError;
}
}
- TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));
+ TRACE_APPEND(("%d\n", match));
/*
* Peep-hole optimisation: if you're about to jump, do jump from here.
@@ -5424,6 +5434,8 @@ TEBCresume(
*/
foundResult:
+ TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr),
+ iResult));
JUMP_PEEPHOLE_F(iResult, 1, 2);
}
@@ -5511,13 +5523,13 @@ TEBCresume(
if (l2 < 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"negative shift argument", -1));
-#if 0
+#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"domain error: argument not in valid range",
NULL);
CACHE_STACK_INFO();
-#endif
+#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
} else if (l1 == 0) {
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
@@ -5559,13 +5571,13 @@ TEBCresume(
if (l2 < 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"negative shift argument", -1));
-#if 0
+#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"domain error: argument not in valid range",
NULL);
CACHE_STACK_INFO();
-#endif
+#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
} else if (l1 == 0) {
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
@@ -5582,12 +5594,12 @@ TEBCresume(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"integer value too large to represent", -1));
-#if 0
+#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
"integer value too large to represent", NULL);
CACHE_STACK_INFO();
-#endif
+#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
} else {
int shift = (int) l2;
@@ -5835,7 +5847,7 @@ TEBCresume(
/* TODO - check claim that taking address of b harms performance */
/* TODO - consider optimization search for constants */
if (TclGetBooleanFromObj(NULL, valuePtr, &b) != TCL_OK) {
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", O2S(valuePtr),
+ TRACE(("\"%.20s\" => ERROR: illegal type %s\n", O2S(valuePtr),
(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
@@ -5844,18 +5856,20 @@ TEBCresume(
}
/* TODO: Consider peephole opt. */
objResultPtr = TCONST(!b);
+ TRACE_WITH_OBJ(("%s => ", O2S(valuePtr)), objResultPtr);
NEXT_INST_F(1, 1, 1);
}
case INST_BITNOT:
valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", O2S(valuePtr)));
if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
|| (type1==TCL_NUMBER_NAN) || (type1==TCL_NUMBER_DOUBLE)) {
/*
* ... ~$NonInteger => raise an error.
*/
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+ TRACE_APPEND(("ERROR: illegal type %s\n",
(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
@@ -5866,23 +5880,28 @@ TEBCresume(
l1 = *((const long *) ptr1);
if (Tcl_IsShared(valuePtr)) {
TclNewLongObj(objResultPtr, ~l1);
+ TRACE_APPEND(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
}
TclSetLongObj(valuePtr, ~l1);
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
if (objResultPtr != NULL) {
+ TRACE_APPEND(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
} else {
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
case INST_UMINUS:
valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", O2S(valuePtr)));
if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
|| IsErroringNaNType(type1)) {
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+ TRACE_APPEND(("ERROR: illegal type %s \n",
(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
@@ -5892,23 +5911,28 @@ TEBCresume(
switch (type1) {
case TCL_NUMBER_NAN:
/* -NaN => NaN */
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
case TCL_NUMBER_LONG:
l1 = *((const long *) ptr1);
if (l1 != LONG_MIN) {
if (Tcl_IsShared(valuePtr)) {
TclNewLongObj(objResultPtr, -l1);
+ TRACE_APPEND(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
}
TclSetLongObj(valuePtr, -l1);
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
/* FALLTHROUGH */
}
objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
if (objResultPtr != NULL) {
+ TRACE_APPEND(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
} else {
+ TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
@@ -5921,6 +5945,7 @@ TEBCresume(
*/
valuePtr = OBJ_AT_TOS;
+ TRACE(("\"%.20s\" => ", O2S(valuePtr)));
if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
if (*pc == INST_UPLUS) {
@@ -5928,7 +5953,7 @@ TEBCresume(
* ... +$NonNumeric => raise an error.
*/
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+ TRACE_APPEND(("ERROR: illegal type %s\n",
(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
@@ -5937,7 +5962,7 @@ TEBCresume(
}
/* ... TryConvertToNumeric($NonNumeric) is acceptable */
- TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr)));
+ TRACE_APPEND(("not numeric\n"));
NEXT_INST_F(1, 0, 0);
}
if (IsErroringNaNType(type1)) {
@@ -5946,7 +5971,7 @@ TEBCresume(
* ... +$NonNumeric => raise an error.
*/
- TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
+ TRACE_APPEND(("ERROR: illegal type %s\n",
(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
@@ -5956,8 +5981,7 @@ TEBCresume(
* Numeric conversion of NaN -> error.
*/
- TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
- O2S(objResultPtr)));
+ TRACE_APPEND(("ERROR: IEEE floating pt error\n"));
DECACHE_STACK_INFO();
TclExprFloatError(interp, *((const double *) ptr1));
CACHE_STACK_INFO();
@@ -5975,7 +5999,7 @@ TEBCresume(
*/
if (valuePtr->bytes == NULL) {
- TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr)));
+ TRACE_APPEND(("numeric, same Tcl_Obj\n"));
NEXT_INST_F(1, 0, 0);
}
if (Tcl_IsShared(valuePtr)) {
@@ -5990,11 +6014,11 @@ TEBCresume(
valuePtr->bytes = NULL;
objResultPtr = Tcl_DuplicateObj(valuePtr);
valuePtr->bytes = savedString;
- TRACE(("\"%.20s\" => numeric, new Tcl_Obj\n", O2S(valuePtr)));
+ TRACE_APPEND(("numeric, new Tcl_Obj\n"));
NEXT_INST_F(1, 1, 1);
}
TclInvalidateStringRep(valuePtr);
- TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr)));
+ TRACE_APPEND(("numeric, same Tcl_Obj\n"));
NEXT_INST_F(1, 0, 0);
}
@@ -6011,6 +6035,7 @@ TEBCresume(
*/
result = TCL_BREAK;
cleanup = 0;
+ TRACE(("=> BREAK!\n"));
goto processExceptionReturn;
case INST_CONTINUE:
@@ -6021,6 +6046,7 @@ TEBCresume(
*/
result = TCL_CONTINUE;
cleanup = 0;
+ TRACE(("=> CONTINUE!\n"));
goto processExceptionReturn;
{
@@ -6169,8 +6195,8 @@ TEBCresume(
listTmpIndex++;
}
}
- TRACE_APPEND(("%d lists, iter %d, %s loop\n", opnd, numLists,
- iterNum, (continueLoop? "continue" : "exit")));
+ TRACE_APPEND(("%d lists, iter %d, %s loop\n",
+ numLists, iterNum, (continueLoop? "continue" : "exit")));
/*
* Run-time peep-hole optimisation: the compiler ALWAYS follows
@@ -6204,6 +6230,7 @@ TEBCresume(
opnd = TclGetUInt4AtPtr(pc+1);
infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
numLists = infoPtr->numLists;
+ TRACE(("%u => ", opnd));
/*
* Compute the number of iterations that will be run: iterMax
@@ -6216,8 +6243,8 @@ TEBCresume(
numVars = varListPtr->numVars;
listPtr = OBJ_AT_DEPTH(listTmpDepth);
if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
- TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ",
- opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp));
+ TRACE_APPEND(("ERROR converting list %ld, \"%s\": %s",
+ i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
goto gotError;
}
if (Tcl_IsShared(listPtr)) {
@@ -6253,6 +6280,7 @@ TEBCresume(
TclNewObj(tmpPtr);
tmpPtr->internalRep.otherValuePtr = infoPtr;
PUSH_OBJECT(tmpPtr); /* infoPtr object */
+ TRACE_APPEND(("jump to loop step\n"));
/*
* Jump directly to the INST_FOREACH_STEP instruction; the C code just
@@ -6270,6 +6298,7 @@ TEBCresume(
tmpPtr = OBJ_AT_TOS;
infoPtr = tmpPtr->internalRep.otherValuePtr;
numLists = infoPtr->numLists;
+ TRACE(("=> "));
tmpPtr = OBJ_AT_DEPTH(1);
iterNum = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr1);
@@ -6323,9 +6352,8 @@ TEBCresume(
if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
CACHE_STACK_INFO();
- TRACE_WITH_OBJ((
- "%u => ERROR init. index temp %d: ",
- opnd,varIndex), Tcl_GetObjResult(interp));
+ TRACE_APPEND(("ERROR init. index temp %d: %.30s",
+ varIndex, O2S(Tcl_GetObjResult(interp))));
goto gotError;
}
CACHE_STACK_INFO();
@@ -6334,10 +6362,12 @@ TEBCresume(
}
listTmpDepth--;
}
+ TRACE_APPEND(("jump to loop start\n"));
/* loopCtTemp being 'misused' for storing the jump size */
NEXT_INST_F(infoPtr->loopCtTemp, 0, 0);
}
+ TRACE_APPEND(("loop has no more iterations\n"));
#ifdef TCL_COMPILE_DEBUG
NEXT_INST_F(1, 0, 0);
#else
@@ -6352,6 +6382,7 @@ TEBCresume(
tmpPtr = OBJ_AT_TOS;
infoPtr = tmpPtr->internalRep.otherValuePtr;
numLists = infoPtr->numLists;
+ TRACE(("=> loop terminated\n"));
NEXT_INST_V(1, numLists+2, 0);
case INST_LMAP_COLLECT:
@@ -6368,6 +6399,7 @@ TEBCresume(
tmpPtr = OBJ_AT_DEPTH(1);
infoPtr = tmpPtr->internalRep.otherValuePtr;
numLists = infoPtr->numLists;
+ TRACE_APPEND(("=> appending to list at depth %d\n", 3 + numLists));
objPtr = OBJ_AT_DEPTH(3 + numLists);
Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS);
@@ -6433,7 +6465,8 @@ TEBCresume(
if (code < TCL_ERROR || code > TCL_CONTINUE) {
code = TCL_CONTINUE + 1;
}
- NEXT_INST_F(2*code -1, 1, 0);
+ TRACE(("\"%s\" => jump offset %d\n", O2S(OBJ_AT_TOS), 2*code-1));
+ NEXT_INST_F(2*code-1, 1, 0);
}
/*
@@ -6450,10 +6483,10 @@ TEBCresume(
case INST_DICT_VERIFY:
dictPtr = OBJ_AT_TOS;
- TRACE(("=> "));
+ TRACE(("\"%.30s\" => ", O2S(dictPtr)));
if (Tcl_DictObjSize(interp, dictPtr, &done) != TCL_OK) {
- TRACE_APPEND(("ERROR verifying dictionary nature of \"%s\": %s\n",
- O2S(OBJ_AT_DEPTH(opnd)), O2S(Tcl_GetObjResult(interp))));
+ TRACE_APPEND(("ERROR verifying dictionary nature of \"%.30s\": %s\n",
+ O2S(dictPtr), O2S(Tcl_GetObjResult(interp))));
goto gotError;
}
TRACE_APPEND(("OK\n"));
@@ -6479,7 +6512,7 @@ TEBCresume(
goto afterDictExists;
}
TRACE_WITH_OBJ((
- "ERROR tracing dictionary path into \"%s\": ",
+ "ERROR tracing dictionary path into \"%.30s\": ",
O2S(OBJ_AT_DEPTH(opnd))),
Tcl_GetObjResult(interp));
goto gotError;
@@ -6492,10 +6525,10 @@ TEBCresume(
goto afterDictExists;
}
if (!objResultPtr) {
- DECACHE_STACK_INFO();
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"key \"%s\" not known in dictionary",
TclGetString(OBJ_AT_TOS)));
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
TclGetString(OBJ_AT_TOS), NULL);
CACHE_STACK_INFO();
@@ -6595,8 +6628,8 @@ TEBCresume(
if (allocateDict) {
TclDecrRefCount(dictPtr);
}
- TRACE_WITH_OBJ(("%u %u => ERROR updating dictionary: ",
- opnd, opnd2), Tcl_GetObjResult(interp));
+ TRACE_APPEND(("ERROR updating dictionary: %s\n",
+ O2S(Tcl_GetObjResult(interp))));
goto checkForCatch;
}
@@ -6959,7 +6992,7 @@ TEBCresume(
case INST_DICT_EXPAND:
dictPtr = OBJ_UNDER_TOS;
listPtr = OBJ_AT_TOS;
- TRACE(("%.30s %.30s =>", O2S(dictPtr), O2S(listPtr)));
+ TRACE(("\"%.30s\" \"%.30s\" =>", O2S(dictPtr), O2S(listPtr)));
if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
@@ -6969,7 +7002,7 @@ TEBCresume(
TRACE_ERROR(interp);
goto gotError;
}
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
case INST_DICT_RECOMBINE_STK:
@@ -7117,10 +7150,10 @@ TEBCresume(
if (traceInstructions) {
objPtr = Tcl_GetObjResult(interp);
if ((result != TCL_ERROR) && (result != TCL_RETURN)) {
- TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ",
+ TRACE_APPEND(("OTHER RETURN CODE %d, result=\"%.30s\"\n ",
result, O2S(objPtr)));
} else {
- TRACE_APPEND(("%s, result= \"%s\"\n",
+ TRACE_APPEND(("%s, result=\"%.30s\"\n",
StringForResultCode(result), O2S(objPtr)));
}
}
@@ -7133,8 +7166,8 @@ TEBCresume(
*/
divideByZero:
- DECACHE_STACK_INFO();
Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1));
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
CACHE_STACK_INFO();
goto gotError;
@@ -7145,9 +7178,9 @@ TEBCresume(
*/
exponOfZero:
- DECACHE_STACK_INFO();
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"exponentiation of zero by negative power", -1));
+ DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"exponentiation of zero by negative power", NULL);
CACHE_STACK_INFO();
generated by cgit v0.12 at 2024-11-21 16:50:06 (GMT)