summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2004-05-21 09:39:27 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2004-05-21 09:39:27 (GMT)
commitba6ec48f9035744eb537bede1f77cffa94e26517 (patch)
tree66daae04b2552af1afe901c791173950ccf01e0e
parent1d3c7f0cdf1c3b528ce39d8bf41ec82af4addaa2 (diff)
downloadtcl-ba6ec48f9035744eb537bede1f77cffa94e26517.zip
tcl-ba6ec48f9035744eb537bede1f77cffa94e26517.tar.gz
tcl-ba6ec48f9035744eb537bede1f77cffa94e26517.tar.bz2
2004-05-21 Miguel Sofer <msofer@users.sf.net>
* generic/tclExecute.c (TclExecuteByteCode): reorganised TEBC automatic variables, defining them in tight blocks instead of at the function level. This has three purposes: - it simplifies the analysis of individual instructions - it is preliminary work to the non-recursive engine - it allows a better register allocation by the optimiser; under gcc3.3, this results in up to 10% runtime in some tests
-rw-r--r--ChangeLog10
-rw-r--r--generic/tclExecute.c2389
2 files changed, 1285 insertions, 1114 deletions
diff --git a/ChangeLog b/ChangeLog
index 9b5c59c..67ac12d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2004-05-21 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclExecute.c (TclExecuteByteCode): reorganised TEBC
+ automatic variables, defining them in tight blocks instead of at
+ the function level. This has three purposes:
+ - it simplifies the analysis of individual instructions
+ - it is preliminary work to the non-recursive engine
+ - it allows a better register allocation by the optimiser; under
+ gcc3.3, this results in up to 10% runtime in some tests
+
2004-05-20 Donal K. Fellows <donal.k.fellows@man.ac.uk>
* generic/tclInterp.c (TclLimitRemoveAllHandlers):
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 59ffb05..da9b7c8 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.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: tclExecute.c,v 1.135 2004/05/18 02:01:36 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.136 2004/05/21 09:39:28 msofer Exp $
*/
#include "tclInt.h"
@@ -1079,17 +1079,16 @@ TclExecuteByteCode(interp, codePtr)
{
/*
* Compiler cast directive - not a real variable.
+ * Interp *iPtr = (Interp *) interp;
*/
-
- Interp *iPtr = (Interp *) interp;
+#define iPtr ((Interp *) interp)
/*
* Constants: variables that do not change during the execution,
* used sporadically.
*/
- ExecEnv *eePtr = iPtr->execEnvPtr;
- /* Points to the execution environment. */
+ ExecEnv *eePtr; /* Points to the execution environment. */
int initStackTop; /* Stack top at start of execution. */
int initCatchTop; /* Catch stack top at start of execution. */
Var *compiledLocals;
@@ -1130,24 +1129,9 @@ TclExecuteByteCode(interp, codePtr)
/*
* Locals - variables that are used within opcodes or bounded sections
* of the file (jumps between opcodes within a family).
+ * NOTE: These are now defined locally where needed.
*/
- ExceptionRange *rangePtr; /* Points to closest loop or catch exception
- * range enclosing the pc. Used by various
- * instructions and processCatch to
- * process break, continue, and errors. */
- int opnd; /* Current instruction's operand byte(s). */
- int pcAdjustment; /* Hold pc adjustment after instruction. */
- int storeFlags;
- Tcl_Obj *valuePtr, *value2Ptr, *objPtr;
- char *bytes;
- int length;
- long i = 0; /* Init. avoids compiler warning. */
- Tcl_WideInt w;
- int isWide;
- char *part1, *part2;
- Var *varPtr, *arrayPtr;
-
#ifdef TCL_COMPILE_DEBUG
int traceInstructions = (tclTraceExec == 3);
char cmdNameBuf[21];
@@ -1163,6 +1147,7 @@ TclExecuteByteCode(interp, codePtr)
* Make sure the execution stack is large enough to execute this ByteCode.
*/
+ eePtr = iPtr->execEnvPtr;
initCatchTop = eePtr->tosPtr - eePtr->stackPtr;
catchTop = initCatchTop;
tosPtr = eePtr->tosPtr + codePtr->maxExceptDepth;
@@ -1211,53 +1196,56 @@ TclExecuteByteCode(interp, codePtr)
* its own cleanup.
*/
- cleanupV_pushObjResultPtr:
- switch (cleanup) {
- case 0:
- *(++tosPtr) = (objResultPtr);
- goto cleanup0;
- default:
- cleanup -= 2;
- while (cleanup--) {
+ {
+ Tcl_Obj *valuePtr;
+
+ cleanupV_pushObjResultPtr:
+ switch (cleanup) {
+ case 0:
+ *(++tosPtr) = (objResultPtr);
+ goto cleanup0;
+ default:
+ cleanup -= 2;
+ while (cleanup--) {
+ valuePtr = POP_OBJECT();
+ TclDecrRefCount(valuePtr);
+ }
+ case 2:
+ cleanup2_pushObjResultPtr:
valuePtr = POP_OBJECT();
TclDecrRefCount(valuePtr);
- }
- case 2:
- cleanup2_pushObjResultPtr:
- valuePtr = POP_OBJECT();
- TclDecrRefCount(valuePtr);
- case 1:
- cleanup1_pushObjResultPtr:
- valuePtr = *tosPtr;
- TclDecrRefCount(valuePtr);
- }
- *tosPtr = objResultPtr;
- goto cleanup0;
-
- cleanupV:
- switch (cleanup) {
- default:
- cleanup -= 2;
- while (cleanup--) {
+ case 1:
+ cleanup1_pushObjResultPtr:
+ valuePtr = *tosPtr;
+ TclDecrRefCount(valuePtr);
+ }
+ *tosPtr = objResultPtr;
+ goto cleanup0;
+
+ cleanupV:
+ switch (cleanup) {
+ default:
+ cleanup -= 2;
+ while (cleanup--) {
+ valuePtr = POP_OBJECT();
+ TclDecrRefCount(valuePtr);
+ }
+ case 2:
+ cleanup2:
valuePtr = POP_OBJECT();
TclDecrRefCount(valuePtr);
- }
- case 2:
- cleanup2:
- valuePtr = POP_OBJECT();
- TclDecrRefCount(valuePtr);
- case 1:
- cleanup1:
- valuePtr = POP_OBJECT();
- TclDecrRefCount(valuePtr);
- case 0:
- /*
- * We really want to do nothing now, but this is needed
- * for some compilers (SunPro CC)
- */
- break;
+ case 1:
+ cleanup1:
+ valuePtr = POP_OBJECT();
+ TclDecrRefCount(valuePtr);
+ case 0:
+ /*
+ * We really want to do nothing now, but this is needed
+ * for some compilers (SunPro CC)
+ */
+ break;
+ }
}
-
cleanup0:
#ifdef TCL_COMPILE_DEBUG
@@ -1336,8 +1324,7 @@ TclExecuteByteCode(interp, codePtr)
* by "processCatch" or "abnormalReturn".
*/
- valuePtr = *tosPtr;
- Tcl_SetObjResult(interp, valuePtr);
+ Tcl_SetObjResult(interp, *tosPtr);
#ifdef TCL_COMPILE_DEBUG
TRACE_WITH_OBJ(("=> return code=%d, result=", result),
iPtr->objResultPtr);
@@ -1358,9 +1345,13 @@ TclExecuteByteCode(interp, codePtr)
NEXT_INST_F(5, 0, 1);
case INST_POP:
- TRACE_WITH_OBJ(("=> discarding "), *tosPtr);
- valuePtr = POP_OBJECT();
- TclDecrRefCount(valuePtr);
+ {
+ Tcl_Obj *valuePtr;
+
+ TRACE_WITH_OBJ(("=> discarding "), *tosPtr);
+ valuePtr = POP_OBJECT();
+ TclDecrRefCount(valuePtr);
+ }
/*
* Runtime peephole optimisation: an INST_POP is scheduled
@@ -1385,6 +1376,10 @@ TclExecuteByteCode(interp, codePtr)
|| (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
NEXT_INST_F(5, 0, 0);
} else {
+ char *bytes;
+ int length, opnd;
+ Tcl_Obj *newObjResultPtr;
+
bytes = GetSrcInfoForPc(pc, codePtr, &length);
result = Tcl_EvalEx(interp, bytes, length, 0);
if (result != TCL_OK) {
@@ -1393,7 +1388,6 @@ TclExecuteByteCode(interp, codePtr)
opnd = TclGetUInt4AtPtr(pc+1);
objResultPtr = Tcl_GetObjResult(interp);
{
- Tcl_Obj *newObjResultPtr;
TclNewObj(newObjResultPtr);
Tcl_IncrRefCount(newObjResultPtr);
iPtr->objResultPtr = newObjResultPtr;
@@ -1407,17 +1401,23 @@ TclExecuteByteCode(interp, codePtr)
NEXT_INST_F(1, 0, 1);
case INST_OVER:
- opnd = TclGetUInt4AtPtr( pc+1 );
- objResultPtr = *(tosPtr - opnd);
- TRACE_WITH_OBJ(("=> "), objResultPtr);
- NEXT_INST_F(5, 0, 1);
+ {
+ int opnd;
+
+ opnd = TclGetUInt4AtPtr( pc+1 );
+ objResultPtr = *(tosPtr - opnd);
+ TRACE_WITH_OBJ(("=> "), objResultPtr);
+ NEXT_INST_F(5, 0, 1);
+ }
case INST_CONCAT1:
- opnd = TclGetUInt1AtPtr(pc+1);
{
- int totalLen = 0;
+ int opnd, length, totalLen = 0;
+ char * bytes;
Tcl_Obj **currPtr;
+ opnd = TclGetUInt1AtPtr(pc+1);
+
/*
* Concatenate strings (with no separators) from the top
* opnd items on the stack starting with the deepest item.
@@ -1473,16 +1473,20 @@ TclExecuteByteCode(interp, codePtr)
* an expansion error, also in INST_EXPAND_STKTOP).
*/
- TclNewObj(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) (tosPtr - eePtr->stackPtr);
- objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) expandNestList;
- expandNestList = objPtr;
- NEXT_INST_F(1, 0, 0);
+ {
+ Tcl_Obj *objPtr;
+
+ TclNewObj(objPtr);
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) (tosPtr - eePtr->stackPtr);
+ objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) expandNestList;
+ expandNestList = objPtr;
+ NEXT_INST_F(1, 0, 0);
+ }
case INST_EXPAND_STKTOP:
{
- int objc;
- Tcl_Obj **objv;
+ int objc, length, i;
+ Tcl_Obj **objv, *valuePtr, *objPtr;
/*
* Make sure that the element at stackTop is a list; if not,
@@ -1528,149 +1532,212 @@ TclExecuteByteCode(interp, codePtr)
NEXT_INST_F(5, 0, 0);
}
- case INST_INVOKE_EXPANDED:
- objPtr = expandNestList;
- expandNestList = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2;
- opnd = tosPtr - eePtr->stackPtr
- - (int) objPtr->internalRep.twoPtrValue.ptr1;
- TclDecrRefCount(objPtr);
+ {
+ /*
+ * INVOCATION BLOCK
+ */
- if (opnd == 0) {
- /*
- * Nothing was expanded, return {}.
- */
-
- TclNewObj(objResultPtr);
- NEXT_INST_F(1, 0, 1);
- }
-
- pcAdjustment = 1;
- goto doInvocation;
-
- case INST_INVOKE_STK4:
- opnd = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- goto doInvocation;
-
- case INST_INVOKE_STK1:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
+ int objc, pcAdjustment;
+
+ case INST_INVOKE_EXPANDED:
+ {
+ Tcl_Obj *objPtr;
+
+ objPtr = expandNestList;
+ expandNestList = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2;
+ objc = tosPtr - eePtr->stackPtr
+ - (int) objPtr->internalRep.twoPtrValue.ptr1;
+ TclDecrRefCount(objPtr);
+ }
+
+ if (objc == 0) {
+ /*
+ * Nothing was expanded, return {}.
+ */
+
+ TclNewObj(objResultPtr);
+ NEXT_INST_F(1, 0, 1);
+ }
- doInvocation:
- {
- int objc = opnd;
- Tcl_Obj **objv = (tosPtr - (objc-1));
-
- /*
- * We keep the stack reference count as a (char *), as that
- * works nicely as a portable pointer-sized counter.
- */
-
- char **preservedStackRefCountPtr;
+ pcAdjustment = 1;
+ goto doInvocation;
+
+ case INST_INVOKE_STK4:
+ objc = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ goto doInvocation;
+
+ case INST_INVOKE_STK1:
+ objc = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
+ doInvocation:
+ {
+ Tcl_Obj **objv = (tosPtr - (objc-1));
+ int length;
+ char *bytes;
+
+ /*
+ * We keep the stack reference count as a (char *), as that
+ * works nicely as a portable pointer-sized counter.
+ */
+
+ char **preservedStackRefCountPtr;
+
#ifdef TCL_COMPILE_DEBUG
- if (tclTraceExec >= 2) {
- if (traceInstructions) {
- strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
- TRACE(("%u => call ", objc));
- } else {
- fprintf(stdout, "%d: (%u) invoking ",
- iPtr->numLevels,
- (unsigned int)(pc - codePtr->codeStart));
- }
- for (i = 0; i < objc; i++) {
- TclPrintObject(stdout, objv[i], 15);
- fprintf(stdout, " ");
+ if (tclTraceExec >= 2) {
+ if (traceInstructions) {
+ strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
+ TRACE(("%u => call ", objc));
+ } else {
+ fprintf(stdout, "%d: (%u) invoking ",
+ iPtr->numLevels,
+ (unsigned int)(pc - codePtr->codeStart));
+ }
+ for (i = 0; i < objc; i++) {
+ TclPrintObject(stdout, objv[i], 15);
+ fprintf(stdout, " ");
+ }
+ fprintf(stdout, "\n");
+ fflush(stdout);
}
- fprintf(stdout, "\n");
- fflush(stdout);
- }
#endif /*TCL_COMPILE_DEBUG*/
-
- /*
- * If trace procedures will be called, we need a
- * command string to pass to TclEvalObjvInternal; note
- * that a copy of the string will be made there to
- * include the ending \0.
- */
-
- bytes = NULL;
- length = 0;
- if (iPtr->tracePtr != NULL) {
- Trace *tracePtr, *nextTracePtr;
+
+ /*
+ * If trace procedures will be called, we need a
+ * command string to pass to TclEvalObjvInternal; note
+ * that a copy of the string will be made there to
+ * include the ending \0.
+ */
+
+ bytes = NULL;
+ length = 0;
+ if (iPtr->tracePtr != NULL) {
+ Trace *tracePtr, *nextTracePtr;
- for (tracePtr = iPtr->tracePtr; tracePtr != NULL;
- tracePtr = nextTracePtr) {
- nextTracePtr = tracePtr->nextPtr;
- if (tracePtr->level == 0 ||
- iPtr->numLevels <= tracePtr->level) {
- /*
- * Traces will be called: get command string
- */
-
+ for (tracePtr = iPtr->tracePtr; tracePtr != NULL;
+ tracePtr = nextTracePtr) {
+ nextTracePtr = tracePtr->nextPtr;
+ if (tracePtr->level == 0 ||
+ iPtr->numLevels <= tracePtr->level) {
+ /*
+ * Traces will be called: get command string
+ */
+
+ bytes = GetSrcInfoForPc(pc, codePtr, &length);
+ break;
+ }
+ }
+ } else {
+ Command *cmdPtr;
+ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
+ if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
bytes = GetSrcInfoForPc(pc, codePtr, &length);
- break;
}
+ }
+
+ /*
+ * A reference to part of the stack vector itself
+ * escapes our control: increase its refCount
+ * to stop it from being deallocated by a recursive
+ * call to ourselves. The extra variable is needed
+ * because all others are liable to change due to the
+ * trace procedures.
+ */
+
+ preservedStackRefCountPtr = (char **) (eePtr->stackPtr-1);
+ ++*preservedStackRefCountPtr;
+
+ /*
+ * Reset the instructionCount variable, since we're about
+ * to check for async stuff anyway while processing
+ * TclEvalObjvInternal.
+ */
+
+ instructionCount = 1;
+
+ /*
+ * Finally, let TclEvalObjvInternal handle the command.
+ */
+
+ DECACHE_STACK_INFO();
+ Tcl_ResetResult(interp);
+ result = TclEvalObjvInternal(interp, objc, objv, bytes, length, 0);
+ CACHE_STACK_INFO();
+
+ /*
+ * If the old stack is going to be released, it is
+ * safe to do so now, since no references to objv are
+ * going to be used from now on.
+ */
+
+ --*preservedStackRefCountPtr;
+ if (*preservedStackRefCountPtr == (char *) 0) {
+ ckfree((VOID *) preservedStackRefCountPtr);
+ }
+
+ if (result == TCL_OK) {
+ /*
+ * Push the call's object result and continue execution
+ * with the next instruction.
+ */
+
+ TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
+ objc, cmdNameBuf), Tcl_GetObjResult(interp));
+
+ objResultPtr = 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.
+ */
+ {
+ Tcl_Obj *objPtr;
+
+ TclNewObj(objPtr);
+ Tcl_IncrRefCount(objPtr);
+ iPtr->objResultPtr = objPtr;
+ }
+
+ NEXT_INST_V(pcAdjustment, objc, -1);
+ } else {
+ cleanup = objc;
+ goto processExceptionReturn;
}
- } else {
- Command *cmdPtr;
- cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
- if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
- bytes = GetSrcInfoForPc(pc, codePtr, &length);
- }
- }
-
- /*
- * A reference to part of the stack vector itself
- * escapes our control: increase its refCount
- * to stop it from being deallocated by a recursive
- * call to ourselves. The extra variable is needed
- * because all others are liable to change due to the
- * trace procedures.
- */
-
- preservedStackRefCountPtr = (char **) (eePtr->stackPtr-1);
- ++*preservedStackRefCountPtr;
-
- /*
- * Reset the instructionCount variable, since we're about
- * to check for async stuff anyway while processing
- * TclEvalObjvInternal.
- */
-
- instructionCount = 1;
+ }
+ }
+
- /*
- * Finally, let TclEvalObjvInternal handle the command.
- */
+ case INST_EVAL_STK:
+ /*
+ * Note to maintainers: it is important that INST_EVAL_STK
+ * pop its argument from the stack before jumping to
+ * checkForCatch! DO NOT OPTIMISE!
+ */
+ {
+ Tcl_Obj *objPtr;
+
+ objPtr = *tosPtr;
DECACHE_STACK_INFO();
- Tcl_ResetResult(interp);
- result = TclEvalObjvInternal(interp, objc, objv, bytes, length, 0);
+ result = TclCompEvalObj(interp, objPtr);
CACHE_STACK_INFO();
-
- /*
- * If the old stack is going to be released, it is
- * safe to do so now, since no references to objv are
- * going to be used from now on.
- */
-
- --*preservedStackRefCountPtr;
- if (*preservedStackRefCountPtr == (char *) 0) {
- ckfree((VOID *) preservedStackRefCountPtr);
- }
-
if (result == TCL_OK) {
/*
- * Push the call's object result and continue execution
- * with the next instruction.
+ * Normal return; push the eval's object result.
*/
-
- TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
- objc, cmdNameBuf), Tcl_GetObjResult(interp));
-
+
objResultPtr = Tcl_GetObjResult(interp);
-
+ TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)),
+ Tcl_GetObjResult(interp));
+
/*
* Reset the interp's result to avoid possible duplications
* of large objects [Bug 781585]. We do not call
@@ -1682,78 +1749,35 @@ TclExecuteByteCode(interp, codePtr)
* Note that the result object is now in objResultPtr, it
* keeps the refCount it had in its role of iPtr->objResultPtr.
*/
- {
- Tcl_Obj *newObjResultPtr;
- TclNewObj(newObjResultPtr);
- Tcl_IncrRefCount(newObjResultPtr);
- iPtr->objResultPtr = newObjResultPtr;
- }
- NEXT_INST_V(pcAdjustment, opnd, -1);
+ TclNewObj(objPtr);
+ Tcl_IncrRefCount(objPtr);
+ iPtr->objResultPtr = objPtr;
+ NEXT_INST_F(1, 1, -1);
} else {
- cleanup = opnd;
+ cleanup = 1;
goto processExceptionReturn;
}
}
- case INST_EVAL_STK:
- /*
- * Note to maintainers: it is important that INST_EVAL_STK
- * pop its argument from the stack before jumping to
- * checkForCatch! DO NOT OPTIMISE!
- */
-
- objPtr = *tosPtr;
- DECACHE_STACK_INFO();
- result = TclCompEvalObj(interp, objPtr);
- CACHE_STACK_INFO();
- if (result == TCL_OK) {
- /*
- * Normal return; push the eval's object result.
- */
-
- objResultPtr = Tcl_GetObjResult(interp);
- TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)),
- 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.
- */
- {
- Tcl_Obj *newObjResultPtr;
- TclNewObj(newObjResultPtr);
- Tcl_IncrRefCount(newObjResultPtr);
- iPtr->objResultPtr = newObjResultPtr;
- }
-
- NEXT_INST_F(1, 1, -1);
- } else {
- cleanup = 1;
- goto processExceptionReturn;
- }
-
case INST_EXPR_STK:
- objPtr = *tosPtr;
- DECACHE_STACK_INFO();
- Tcl_ResetResult(interp);
- result = Tcl_ExprObj(interp, objPtr, &valuePtr);
- CACHE_STACK_INFO();
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ",
- O2S(objPtr)), Tcl_GetObjResult(interp));
- goto checkForCatch;
+ {
+ Tcl_Obj *objPtr, *valuePtr;
+
+ objPtr = *tosPtr;
+ DECACHE_STACK_INFO();
+ Tcl_ResetResult(interp);
+ result = Tcl_ExprObj(interp, objPtr, &valuePtr);
+ CACHE_STACK_INFO();
+ if (result != TCL_OK) {
+ TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ",
+ O2S(objPtr)), Tcl_GetObjResult(interp));
+ goto checkForCatch;
+ }
+ objResultPtr = valuePtr;
+ TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
+ NEXT_INST_F(1, 1, -1); /* already has right refct */
}
- objResultPtr = valuePtr;
- TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)), valuePtr);
- NEXT_INST_F(1, 1, -1); /* already has right refct */
/*
* ---------------------------------------------------------
@@ -1763,148 +1787,154 @@ TclExecuteByteCode(interp, codePtr)
* The different instructions set the value of some variables
* and then jump to somme common execution code.
*/
+ {
+ int opnd, pcAdjustment;
+ char *part1, *part2;
+ Var *varPtr, *arrayPtr;
+ Tcl_Obj *objPtr;
+
+ case INST_LOAD_SCALAR1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ varPtr = &(compiledLocals[opnd]);
+ part1 = varPtr->name;
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ TRACE(("%u => ", opnd));
+ if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)
+ && (varPtr->tracePtr == NULL)) {
+ /*
+ * No errors, no traces: just get the value.
+ */
+ objResultPtr = varPtr->value.objPtr;
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_F(2, 0, 1);
+ }
+ pcAdjustment = 2;
+ cleanup = 0;
+ arrayPtr = NULL;
+ part2 = NULL;
+ goto doCallPtrGetVar;
- case INST_LOAD_SCALAR1:
- opnd = TclGetUInt1AtPtr(pc+1);
- varPtr = &(compiledLocals[opnd]);
- part1 = varPtr->name;
- while (TclIsVarLink(varPtr)) {
- varPtr = varPtr->value.linkPtr;
- }
- TRACE(("%u => ", opnd));
- if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)
- && (varPtr->tracePtr == NULL)) {
- /*
- * No errors, no traces: just get the value.
- */
- objResultPtr = varPtr->value.objPtr;
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_F(2, 0, 1);
- }
- pcAdjustment = 2;
- cleanup = 0;
- arrayPtr = NULL;
- part2 = NULL;
- goto doCallPtrGetVar;
-
- case INST_LOAD_SCALAR4:
- opnd = TclGetUInt4AtPtr(pc+1);
- varPtr = &(compiledLocals[opnd]);
- part1 = varPtr->name;
- while (TclIsVarLink(varPtr)) {
- varPtr = varPtr->value.linkPtr;
- }
- TRACE(("%u => ", opnd));
- if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)
- && (varPtr->tracePtr == NULL)) {
- /*
- * No errors, no traces: just get the value.
- */
- objResultPtr = varPtr->value.objPtr;
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_F(5, 0, 1);
- }
- pcAdjustment = 5;
- cleanup = 0;
- arrayPtr = NULL;
- part2 = NULL;
- goto doCallPtrGetVar;
-
- case INST_LOAD_ARRAY_STK:
- cleanup = 2;
- part2 = Tcl_GetString(*tosPtr); /* element name */
- objPtr = *(tosPtr - 1); /* array name */
- TRACE(("\"%.30s(%.30s)\" => ", O2S(objPtr), part2));
- goto doLoadStk;
-
- case INST_LOAD_STK:
- case INST_LOAD_SCALAR_STK:
- cleanup = 1;
- part2 = NULL;
- objPtr = *tosPtr; /* variable name */
- TRACE(("\"%.30s\" => ", O2S(objPtr)));
-
- doLoadStk:
- part1 = TclGetString(objPtr);
- varPtr = TclObjLookupVar(interp, objPtr, part2,
- TCL_LEAVE_ERR_MSG, "read",
- /*createPart1*/ 0,
- /*createPart2*/ 1, &arrayPtr);
- if (varPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
- }
- if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)
- && (varPtr->tracePtr == NULL)
- && ((arrayPtr == NULL)
- || (arrayPtr->tracePtr == NULL))) {
- /*
- * No errors, no traces: just get the value.
- */
- objResultPtr = varPtr->value.objPtr;
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_V(1, cleanup, 1);
- }
- pcAdjustment = 1;
- goto doCallPtrGetVar;
-
- case INST_LOAD_ARRAY4:
- opnd = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- goto doLoadArray;
-
- case INST_LOAD_ARRAY1:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
-
- doLoadArray:
- part2 = TclGetString(*tosPtr);
- arrayPtr = &(compiledLocals[opnd]);
- part1 = arrayPtr->name;
- while (TclIsVarLink(arrayPtr)) {
- arrayPtr = arrayPtr->value.linkPtr;
- }
- TRACE(("%u \"%.30s\" => ", opnd, part2));
- varPtr = TclLookupArrayElement(interp, part1, part2,
- TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr);
- if (varPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
- }
- if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)
- && (varPtr->tracePtr == NULL)
- && ((arrayPtr == NULL)
- || (arrayPtr->tracePtr == NULL))) {
+ case INST_LOAD_SCALAR4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ varPtr = &(compiledLocals[opnd]);
+ part1 = varPtr->name;
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ TRACE(("%u => ", opnd));
+ if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)
+ && (varPtr->tracePtr == NULL)) {
+ /*
+ * No errors, no traces: just get the value.
+ */
+ objResultPtr = varPtr->value.objPtr;
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_F(5, 0, 1);
+ }
+ pcAdjustment = 5;
+ cleanup = 0;
+ arrayPtr = NULL;
+ part2 = NULL;
+ goto doCallPtrGetVar;
+
+ case INST_LOAD_ARRAY_STK:
+ cleanup = 2;
+ part2 = Tcl_GetString(*tosPtr); /* element name */
+ objPtr = *(tosPtr - 1); /* array name */
+ TRACE(("\"%.30s(%.30s)\" => ", O2S(objPtr), part2));
+ goto doLoadStk;
+
+ case INST_LOAD_STK:
+ case INST_LOAD_SCALAR_STK:
+ cleanup = 1;
+ part2 = NULL;
+ objPtr = *tosPtr; /* variable name */
+ TRACE(("\"%.30s\" => ", O2S(objPtr)));
+
+ doLoadStk:
+ part1 = TclGetString(objPtr);
+ varPtr = TclObjLookupVar(interp, objPtr, part2,
+ TCL_LEAVE_ERR_MSG, "read",
+ /*createPart1*/ 0,
+ /*createPart2*/ 1, &arrayPtr);
+ if (varPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+ if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)
+ && (varPtr->tracePtr == NULL)
+ && ((arrayPtr == NULL)
+ || (arrayPtr->tracePtr == NULL))) {
+ /*
+ * No errors, no traces: just get the value.
+ */
+ objResultPtr = varPtr->value.objPtr;
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_V(1, cleanup, 1);
+ }
+ pcAdjustment = 1;
+ goto doCallPtrGetVar;
+
+ case INST_LOAD_ARRAY4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ goto doLoadArray;
+
+ case INST_LOAD_ARRAY1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
+
+ doLoadArray:
+ part2 = TclGetString(*tosPtr);
+ arrayPtr = &(compiledLocals[opnd]);
+ part1 = arrayPtr->name;
+ while (TclIsVarLink(arrayPtr)) {
+ arrayPtr = arrayPtr->value.linkPtr;
+ }
+ TRACE(("%u \"%.30s\" => ", opnd, part2));
+ varPtr = TclLookupArrayElement(interp, part1, part2,
+ TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr);
+ if (varPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+ if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)
+ && (varPtr->tracePtr == NULL)
+ && ((arrayPtr == NULL)
+ || (arrayPtr->tracePtr == NULL))) {
+ /*
+ * No errors, no traces: just get the value.
+ */
+ objResultPtr = varPtr->value.objPtr;
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ NEXT_INST_F(pcAdjustment, 1, 1);
+ }
+ cleanup = 1;
+ goto doCallPtrGetVar;
+
+ doCallPtrGetVar:
/*
- * No errors, no traces: just get the value.
+ * There are either errors or the variable is traced:
+ * call TclPtrGetVar to process fully.
*/
- objResultPtr = varPtr->value.objPtr;
+
+ DECACHE_STACK_INFO();
+ objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1,
+ part2, TCL_LEAVE_ERR_MSG);
+ CACHE_STACK_INFO();
+ if (objResultPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_F(pcAdjustment, 1, 1);
- }
- cleanup = 1;
- goto doCallPtrGetVar;
-
- doCallPtrGetVar:
- /*
- * There are either errors or the variable is traced:
- * call TclPtrGetVar to process fully.
- */
-
- DECACHE_STACK_INFO();
- objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1,
- part2, TCL_LEAVE_ERR_MSG);
- CACHE_STACK_INFO();
- if (objResultPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
- }
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_V(pcAdjustment, cleanup, 1);
-
+ NEXT_INST_V(pcAdjustment, cleanup, 1);
+ }
+
/*
* End of INST_LOAD instructions.
* ---------------------------------------------------------
@@ -1919,228 +1949,234 @@ TclExecuteByteCode(interp, codePtr)
* and then jump to somme common execution code.
*/
- case INST_LAPPEND_STK:
- valuePtr = *tosPtr; /* value to append */
- part2 = NULL;
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
- goto doStoreStk;
-
- case INST_LAPPEND_ARRAY_STK:
- valuePtr = *tosPtr; /* value to append */
- part2 = TclGetString(*(tosPtr - 1));
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
- goto doStoreStk;
-
- case INST_APPEND_STK:
- valuePtr = *tosPtr; /* value to append */
- part2 = NULL;
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
- goto doStoreStk;
-
- case INST_APPEND_ARRAY_STK:
- valuePtr = *tosPtr; /* value to append */
- part2 = TclGetString(*(tosPtr - 1));
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
- goto doStoreStk;
-
- case INST_STORE_ARRAY_STK:
- valuePtr = *tosPtr;
- part2 = TclGetString(*(tosPtr - 1));
- storeFlags = TCL_LEAVE_ERR_MSG;
- goto doStoreStk;
+ {
+ int opnd, pcAdjustment, storeFlags;
+ char *part1, *part2;
+ Var *varPtr, *arrayPtr;
+ Tcl_Obj *objPtr, *valuePtr;
- case INST_STORE_STK:
- case INST_STORE_SCALAR_STK:
- valuePtr = *tosPtr;
- part2 = NULL;
- storeFlags = TCL_LEAVE_ERR_MSG;
+ case INST_LAPPEND_STK:
+ valuePtr = *tosPtr; /* value to append */
+ part2 = NULL;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
+ | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ goto doStoreStk;
+
+ case INST_LAPPEND_ARRAY_STK:
+ valuePtr = *tosPtr; /* value to append */
+ part2 = TclGetString(*(tosPtr - 1));
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
+ | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ goto doStoreStk;
+
+ case INST_APPEND_STK:
+ valuePtr = *tosPtr; /* value to append */
+ part2 = NULL;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
+ goto doStoreStk;
+
+ case INST_APPEND_ARRAY_STK:
+ valuePtr = *tosPtr; /* value to append */
+ part2 = TclGetString(*(tosPtr - 1));
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
+ goto doStoreStk;
+
+ case INST_STORE_ARRAY_STK:
+ valuePtr = *tosPtr;
+ part2 = TclGetString(*(tosPtr - 1));
+ storeFlags = TCL_LEAVE_ERR_MSG;
+ goto doStoreStk;
- doStoreStk:
- objPtr = *(tosPtr - 1 - (part2 != NULL)); /* variable name */
- part1 = TclGetString(objPtr);
+ case INST_STORE_STK:
+ case INST_STORE_SCALAR_STK:
+ valuePtr = *tosPtr;
+ part2 = NULL;
+ storeFlags = TCL_LEAVE_ERR_MSG;
+
+ doStoreStk:
+ objPtr = *(tosPtr - 1 - (part2 != NULL)); /* variable name */
+ part1 = TclGetString(objPtr);
#ifdef TCL_COMPILE_DEBUG
- if (part2 == NULL) {
- TRACE(("\"%.30s\" <- \"%.30s\" =>",
- part1, O2S(valuePtr)));
- } else {
- TRACE(("\"%.30s(%.30s)\" <- \"%.30s\" => ",
- part1, part2, O2S(valuePtr)));
- }
+ if (part2 == NULL) {
+ TRACE(("\"%.30s\" <- \"%.30s\" =>",
+ part1, O2S(valuePtr)));
+ } else {
+ TRACE(("\"%.30s(%.30s)\" <- \"%.30s\" => ",
+ part1, part2, O2S(valuePtr)));
+ }
#endif
- varPtr = TclObjLookupVar(interp, objPtr, part2,
- TCL_LEAVE_ERR_MSG, "set",
- /*createPart1*/ 1,
- /*createPart2*/ 1, &arrayPtr);
- if (varPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
- }
- cleanup = ((part2 == NULL)? 2 : 3);
- pcAdjustment = 1;
- goto doCallPtrSetVar;
-
- case INST_LAPPEND_ARRAY4:
- opnd = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
- goto doStoreArray;
-
- case INST_LAPPEND_ARRAY1:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
- goto doStoreArray;
-
- case INST_APPEND_ARRAY4:
- opnd = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
- goto doStoreArray;
-
- case INST_APPEND_ARRAY1:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
- goto doStoreArray;
-
- case INST_STORE_ARRAY4:
- opnd = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- storeFlags = TCL_LEAVE_ERR_MSG;
- goto doStoreArray;
-
- case INST_STORE_ARRAY1:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
- storeFlags = TCL_LEAVE_ERR_MSG;
+ varPtr = TclObjLookupVar(interp, objPtr, part2,
+ TCL_LEAVE_ERR_MSG, "set",
+ /*createPart1*/ 1,
+ /*createPart2*/ 1, &arrayPtr);
+ if (varPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+ cleanup = ((part2 == NULL)? 2 : 3);
+ pcAdjustment = 1;
+ goto doCallPtrSetVar;
- doStoreArray:
- valuePtr = *tosPtr;
- part2 = TclGetString(*(tosPtr - 1));
- arrayPtr = &(compiledLocals[opnd]);
- part1 = arrayPtr->name;
- TRACE(("%u \"%.30s\" <- \"%.30s\" => ",
- opnd, part2, O2S(valuePtr)));
- while (TclIsVarLink(arrayPtr)) {
- arrayPtr = arrayPtr->value.linkPtr;
- }
- varPtr = TclLookupArrayElement(interp, part1, part2,
- TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr);
- if (varPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
- }
- cleanup = 2;
- goto doCallPtrSetVar;
-
- case INST_LAPPEND_SCALAR4:
- opnd = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
- goto doStoreScalar;
-
- case INST_LAPPEND_SCALAR1:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
- | TCL_LIST_ELEMENT | TCL_TRACE_READS);
- goto doStoreScalar;
-
- case INST_APPEND_SCALAR4:
- opnd = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
- goto doStoreScalar;
-
- case INST_APPEND_SCALAR1:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
- storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
- goto doStoreScalar;
-
- case INST_STORE_SCALAR4:
- opnd = TclGetUInt4AtPtr(pc+1);
- pcAdjustment = 5;
- storeFlags = TCL_LEAVE_ERR_MSG;
- goto doStoreScalar;
-
- case INST_STORE_SCALAR1:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
- storeFlags = TCL_LEAVE_ERR_MSG;
-
- doStoreScalar:
- valuePtr = *tosPtr;
- varPtr = &(compiledLocals[opnd]);
- part1 = varPtr->name;
- TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
- while (TclIsVarLink(varPtr)) {
- varPtr = varPtr->value.linkPtr;
- }
- cleanup = 1;
- arrayPtr = NULL;
- part2 = NULL;
-
- doCallPtrSetVar:
- if ((storeFlags == TCL_LEAVE_ERR_MSG)
- && !((varPtr->flags & VAR_IN_HASHTABLE)
- && (varPtr->hPtr == NULL))
- && (varPtr->tracePtr == NULL)
- && (TclIsVarScalar(varPtr)
- || TclIsVarUndefined(varPtr))
- && ((arrayPtr == NULL)
- || (arrayPtr->tracePtr == NULL))) {
- /*
- * No traces, no errors, plain 'set': we can safely inline.
- * The value *will* be set to what's requested, so that
- * the stack top remains pointing to the same Tcl_Obj.
- */
- valuePtr = varPtr->value.objPtr;
- objResultPtr = *tosPtr;
- if (valuePtr != objResultPtr) {
- if (valuePtr != NULL) {
- TclDecrRefCount(valuePtr);
- } else {
- TclSetVarScalar(varPtr);
- TclClearVarUndefined(varPtr);
+ case INST_LAPPEND_ARRAY4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
+ | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ goto doStoreArray;
+
+ case INST_LAPPEND_ARRAY1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
+ | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ goto doStoreArray;
+
+ case INST_APPEND_ARRAY4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
+ goto doStoreArray;
+
+ case INST_APPEND_ARRAY1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
+ goto doStoreArray;
+
+ case INST_STORE_ARRAY4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ storeFlags = TCL_LEAVE_ERR_MSG;
+ goto doStoreArray;
+
+ case INST_STORE_ARRAY1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
+ storeFlags = TCL_LEAVE_ERR_MSG;
+
+ doStoreArray:
+ valuePtr = *tosPtr;
+ part2 = TclGetString(*(tosPtr - 1));
+ arrayPtr = &(compiledLocals[opnd]);
+ part1 = arrayPtr->name;
+ TRACE(("%u \"%.30s\" <- \"%.30s\" => ",
+ opnd, part2, O2S(valuePtr)));
+ while (TclIsVarLink(arrayPtr)) {
+ arrayPtr = arrayPtr->value.linkPtr;
+ }
+ varPtr = TclLookupArrayElement(interp, part1, part2,
+ TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr);
+ if (varPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+ cleanup = 2;
+ goto doCallPtrSetVar;
+
+ case INST_LAPPEND_SCALAR4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
+ | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ goto doStoreScalar;
+
+ case INST_LAPPEND_SCALAR1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
+ | TCL_LIST_ELEMENT | TCL_TRACE_READS);
+ goto doStoreScalar;
+
+ case INST_APPEND_SCALAR4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
+ goto doStoreScalar;
+
+ case INST_APPEND_SCALAR1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
+ storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
+ goto doStoreScalar;
+
+ case INST_STORE_SCALAR4:
+ opnd = TclGetUInt4AtPtr(pc+1);
+ pcAdjustment = 5;
+ storeFlags = TCL_LEAVE_ERR_MSG;
+ goto doStoreScalar;
+
+ case INST_STORE_SCALAR1:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ pcAdjustment = 2;
+ storeFlags = TCL_LEAVE_ERR_MSG;
+
+ doStoreScalar:
+ valuePtr = *tosPtr;
+ varPtr = &(compiledLocals[opnd]);
+ part1 = varPtr->name;
+ TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ cleanup = 1;
+ arrayPtr = NULL;
+ part2 = NULL;
+
+ doCallPtrSetVar:
+ if ((storeFlags == TCL_LEAVE_ERR_MSG)
+ && !((varPtr->flags & VAR_IN_HASHTABLE)
+ && (varPtr->hPtr == NULL))
+ && (varPtr->tracePtr == NULL)
+ && (TclIsVarScalar(varPtr)
+ || TclIsVarUndefined(varPtr))
+ && ((arrayPtr == NULL)
+ || (arrayPtr->tracePtr == NULL))) {
+ /*
+ * No traces, no errors, plain 'set': we can safely inline.
+ * The value *will* be set to what's requested, so that
+ * the stack top remains pointing to the same Tcl_Obj.
+ */
+ valuePtr = varPtr->value.objPtr;
+ objResultPtr = *tosPtr;
+ if (valuePtr != objResultPtr) {
+ if (valuePtr != NULL) {
+ TclDecrRefCount(valuePtr);
+ } else {
+ TclSetVarScalar(varPtr);
+ TclClearVarUndefined(varPtr);
+ }
+ varPtr->value.objPtr = objResultPtr;
+ Tcl_IncrRefCount(objResultPtr);
+ }
+#ifndef TCL_COMPILE_DEBUG
+ if (*(pc+pcAdjustment) == INST_POP) {
+ NEXT_INST_V((pcAdjustment+1), cleanup, 0);
+ }
+#else
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+#endif
+ NEXT_INST_V(pcAdjustment, cleanup, 1);
+ } else {
+ DECACHE_STACK_INFO();
+ objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr,
+ part1, part2, valuePtr, storeFlags);
+ CACHE_STACK_INFO();
+ if (objResultPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ result = TCL_ERROR;
+ goto checkForCatch;
}
- varPtr->value.objPtr = objResultPtr;
- Tcl_IncrRefCount(objResultPtr);
}
#ifndef TCL_COMPILE_DEBUG
if (*(pc+pcAdjustment) == INST_POP) {
NEXT_INST_V((pcAdjustment+1), cleanup, 0);
}
-#else
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
#endif
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
NEXT_INST_V(pcAdjustment, cleanup, 1);
- } else {
- DECACHE_STACK_INFO();
- objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr,
- part1, part2, valuePtr, storeFlags);
- CACHE_STACK_INFO();
- if (objResultPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
- }
- }
-#ifndef TCL_COMPILE_DEBUG
- if (*(pc+pcAdjustment) == INST_POP) {
- NEXT_INST_V((pcAdjustment+1), cleanup, 0);
- }
-#endif
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
- NEXT_INST_V(pcAdjustment, cleanup, 1);
-
+ }
/*
* End of INST_STORE and related instructions.
@@ -2156,189 +2192,200 @@ TclExecuteByteCode(interp, codePtr)
* and then jump to somme common execution code.
*/
- case INST_INCR_SCALAR1:
- case INST_INCR_ARRAY1:
- case INST_INCR_ARRAY_STK:
- case INST_INCR_SCALAR_STK:
- case INST_INCR_STK:
- opnd = TclGetUInt1AtPtr(pc+1);
- valuePtr = *tosPtr;
- if (valuePtr->typePtr == &tclIntType) {
- i = valuePtr->internalRep.longValue;
- isWide = 0;
- } else if (valuePtr->typePtr == &tclWideIntType) {
- w = valuePtr->internalRep.wideValue;
- isWide = 1;
- } else {
- REQUIRE_WIDE_OR_INT(result, valuePtr, i, w);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("%u (by %s) => ERROR converting increment amount to int: ",
- opnd, O2S(valuePtr)), Tcl_GetObjResult(interp));
- DECACHE_STACK_INFO();
- Tcl_AddErrorInfo(interp, "\n (reading increment)");
- CACHE_STACK_INFO();
- goto checkForCatch;
- }
- isWide = (valuePtr->typePtr == &tclWideIntType);
- }
- tosPtr--;
- TclDecrRefCount(valuePtr);
- switch (*pc) {
- case INST_INCR_SCALAR1:
- pcAdjustment = 2;
- goto doIncrScalar;
- case INST_INCR_ARRAY1:
- pcAdjustment = 2;
- goto doIncrArray;
- default:
- pcAdjustment = 1;
- goto doIncrStk;
- }
-
- case INST_INCR_ARRAY_STK_IMM:
- case INST_INCR_SCALAR_STK_IMM:
- case INST_INCR_STK_IMM:
- i = TclGetInt1AtPtr(pc+1);
- isWide = 0;
- pcAdjustment = 2;
-
- doIncrStk:
- if ((*pc == INST_INCR_ARRAY_STK_IMM)
- || (*pc == INST_INCR_ARRAY_STK)) {
- part2 = TclGetString(*tosPtr);
- objPtr = *(tosPtr - 1);
- TRACE(("\"%.30s(%.30s)\" (by %ld) => ",
- O2S(objPtr), part2, i));
- } else {
- part2 = NULL;
- objPtr = *tosPtr;
- TRACE(("\"%.30s\" (by %ld) => ", O2S(objPtr), i));
- }
- part1 = TclGetString(objPtr);
-
- varPtr = TclObjLookupVar(interp, objPtr, part2,
- TCL_LEAVE_ERR_MSG, "read", 0, 1, &arrayPtr);
- if (varPtr == NULL) {
- DECACHE_STACK_INFO();
- Tcl_AddObjErrorInfo(interp,
- "\n (reading value of variable to increment)", -1);
- CACHE_STACK_INFO();
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
- }
- cleanup = ((part2 == NULL)? 1 : 2);
- goto doIncrVar;
-
- case INST_INCR_ARRAY1_IMM:
- opnd = TclGetUInt1AtPtr(pc+1);
- i = TclGetInt1AtPtr(pc+2);
- isWide = 0;
- pcAdjustment = 3;
-
- doIncrArray:
- part2 = TclGetString(*tosPtr);
- arrayPtr = &(compiledLocals[opnd]);
- part1 = arrayPtr->name;
- while (TclIsVarLink(arrayPtr)) {
- arrayPtr = arrayPtr->value.linkPtr;
- }
- TRACE(("%u \"%.30s\" (by %ld) => ",
- opnd, part2, i));
- varPtr = TclLookupArrayElement(interp, part1, part2,
- TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr);
- if (varPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
- }
- cleanup = 1;
- goto doIncrVar;
-
- case INST_INCR_SCALAR1_IMM:
- opnd = TclGetUInt1AtPtr(pc+1);
- i = TclGetInt1AtPtr(pc+2);
- isWide = 0;
- pcAdjustment = 3;
-
- doIncrScalar:
- varPtr = &(compiledLocals[opnd]);
- part1 = varPtr->name;
- while (TclIsVarLink(varPtr)) {
- varPtr = varPtr->value.linkPtr;
- }
- arrayPtr = NULL;
- part2 = NULL;
- cleanup = 0;
- TRACE(("%u %ld => ", opnd, i));
-
-
- doIncrVar:
- objPtr = varPtr->value.objPtr;
- if (TclIsVarScalar(varPtr)
- && !TclIsVarUndefined(varPtr)
- && (varPtr->tracePtr == NULL)
- && ((arrayPtr == NULL)
- || (arrayPtr->tracePtr == NULL))) {
- if (objPtr->typePtr == &tclIntType && !isWide) {
- /*
- * No errors, no traces, the variable already has an
- * integer value: inline processing.
- */
-
- i += objPtr->internalRep.longValue;
- if (Tcl_IsShared(objPtr)) {
- objResultPtr = Tcl_NewLongObj(i);
- TclDecrRefCount(objPtr);
- Tcl_IncrRefCount(objResultPtr);
- varPtr->value.objPtr = objResultPtr;
- } else {
- Tcl_SetLongObj(objPtr, i);
- objResultPtr = objPtr;
- }
- goto doneIncr;
- } else if (objPtr->typePtr == &tclWideIntType && isWide) {
- /*
- * No errors, no traces, the variable already has a
- * wide integer value: inline processing.
- */
-
- w += objPtr->internalRep.wideValue;
- if (Tcl_IsShared(objPtr)) {
- objResultPtr = Tcl_NewWideIntObj(w);
- TclDecrRefCount(objPtr);
- Tcl_IncrRefCount(objResultPtr);
- varPtr->value.objPtr = objResultPtr;
- } else {
- Tcl_SetWideIntObj(objPtr, w);
- objResultPtr = objPtr;
- }
- goto doneIncr;
- }
- }
- DECACHE_STACK_INFO();
- if (isWide) {
- objResultPtr = TclPtrIncrWideVar(interp, varPtr, arrayPtr, part1,
- part2, w, TCL_LEAVE_ERR_MSG);
- } else {
- objResultPtr = TclPtrIncrVar(interp, varPtr, arrayPtr, part1,
- part2, i, TCL_LEAVE_ERR_MSG);
- }
- CACHE_STACK_INFO();
- if (objResultPtr == NULL) {
- TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
- result = TCL_ERROR;
- goto checkForCatch;
- }
- doneIncr:
- TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+ {
+ Tcl_Obj *objPtr;
+ int opnd, pcAdjustment, isWide;
+ long i;
+ Tcl_WideInt w;
+ char *part1, *part2;
+ Var *varPtr, *arrayPtr;
+
+ case INST_INCR_SCALAR1:
+ case INST_INCR_ARRAY1:
+ case INST_INCR_ARRAY_STK:
+ case INST_INCR_SCALAR_STK:
+ case INST_INCR_STK:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ objPtr = *tosPtr;
+ if (objPtr->typePtr == &tclIntType) {
+ i = objPtr->internalRep.longValue;
+ isWide = 0;
+ } else if (objPtr->typePtr == &tclWideIntType) {
+ i = 0; /* lint */
+ w = objPtr->internalRep.wideValue;
+ isWide = 1;
+ } else {
+ i = 0; /* lint */
+ REQUIRE_WIDE_OR_INT(result, objPtr, i, w);
+ if (result != TCL_OK) {
+ TRACE_WITH_OBJ(("%u (by %s) => ERROR converting increment amount to int: ",
+ opnd, O2S(objPtr)), Tcl_GetObjResult(interp));
+ DECACHE_STACK_INFO();
+ Tcl_AddErrorInfo(interp, "\n (reading increment)");
+ CACHE_STACK_INFO();
+ goto checkForCatch;
+ }
+ isWide = (objPtr->typePtr == &tclWideIntType);
+ }
+ tosPtr--;
+ TclDecrRefCount(objPtr);
+ switch (*pc) {
+ case INST_INCR_SCALAR1:
+ pcAdjustment = 2;
+ goto doIncrScalar;
+ case INST_INCR_ARRAY1:
+ pcAdjustment = 2;
+ goto doIncrArray;
+ default:
+ pcAdjustment = 1;
+ goto doIncrStk;
+ }
+
+ case INST_INCR_ARRAY_STK_IMM:
+ case INST_INCR_SCALAR_STK_IMM:
+ case INST_INCR_STK_IMM:
+ i = TclGetInt1AtPtr(pc+1);
+ isWide = 0;
+ pcAdjustment = 2;
+
+ doIncrStk:
+ if ((*pc == INST_INCR_ARRAY_STK_IMM)
+ || (*pc == INST_INCR_ARRAY_STK)) {
+ part2 = TclGetString(*tosPtr);
+ objPtr = *(tosPtr - 1);
+ TRACE(("\"%.30s(%.30s)\" (by %ld) => ",
+ O2S(objPtr), part2, i));
+ } else {
+ part2 = NULL;
+ objPtr = *tosPtr;
+ TRACE(("\"%.30s\" (by %ld) => ", O2S(objPtr), i));
+ }
+ part1 = TclGetString(objPtr);
+
+ varPtr = TclObjLookupVar(interp, objPtr, part2,
+ TCL_LEAVE_ERR_MSG, "read", 0, 1, &arrayPtr);
+ if (varPtr == NULL) {
+ DECACHE_STACK_INFO();
+ Tcl_AddObjErrorInfo(interp,
+ "\n (reading value of variable to increment)", -1);
+ CACHE_STACK_INFO();
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+ cleanup = ((part2 == NULL)? 1 : 2);
+ goto doIncrVar;
+
+ case INST_INCR_ARRAY1_IMM:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ i = TclGetInt1AtPtr(pc+2);
+ isWide = 0;
+ pcAdjustment = 3;
+
+ doIncrArray:
+ part2 = TclGetString(*tosPtr);
+ arrayPtr = &(compiledLocals[opnd]);
+ part1 = arrayPtr->name;
+ while (TclIsVarLink(arrayPtr)) {
+ arrayPtr = arrayPtr->value.linkPtr;
+ }
+ TRACE(("%u \"%.30s\" (by %ld) => ",
+ opnd, part2, i));
+ varPtr = TclLookupArrayElement(interp, part1, part2,
+ TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr);
+ if (varPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+ cleanup = 1;
+ goto doIncrVar;
+
+ case INST_INCR_SCALAR1_IMM:
+ opnd = TclGetUInt1AtPtr(pc+1);
+ i = TclGetInt1AtPtr(pc+2);
+ isWide = 0;
+ pcAdjustment = 3;
+
+ doIncrScalar:
+ varPtr = &(compiledLocals[opnd]);
+ part1 = varPtr->name;
+ while (TclIsVarLink(varPtr)) {
+ varPtr = varPtr->value.linkPtr;
+ }
+ arrayPtr = NULL;
+ part2 = NULL;
+ cleanup = 0;
+ TRACE(("%u %ld => ", opnd, i));
+
+
+ doIncrVar:
+ objPtr = varPtr->value.objPtr;
+ if (TclIsVarScalar(varPtr)
+ && !TclIsVarUndefined(varPtr)
+ && (varPtr->tracePtr == NULL)
+ && ((arrayPtr == NULL)
+ || (arrayPtr->tracePtr == NULL))) {
+ if (objPtr->typePtr == &tclIntType && !isWide) {
+ /*
+ * No errors, no traces, the variable already has an
+ * integer value: inline processing.
+ */
+
+ i += objPtr->internalRep.longValue;
+ if (Tcl_IsShared(objPtr)) {
+ objResultPtr = Tcl_NewLongObj(i);
+ TclDecrRefCount(objPtr);
+ Tcl_IncrRefCount(objResultPtr);
+ varPtr->value.objPtr = objResultPtr;
+ } else {
+ Tcl_SetLongObj(objPtr, i);
+ objResultPtr = objPtr;
+ }
+ goto doneIncr;
+ } else if (objPtr->typePtr == &tclWideIntType && isWide) {
+ /*
+ * No errors, no traces, the variable already has a
+ * wide integer value: inline processing.
+ */
+
+ w += objPtr->internalRep.wideValue;
+ if (Tcl_IsShared(objPtr)) {
+ objResultPtr = Tcl_NewWideIntObj(w);
+ TclDecrRefCount(objPtr);
+ Tcl_IncrRefCount(objResultPtr);
+ varPtr->value.objPtr = objResultPtr;
+ } else {
+ Tcl_SetWideIntObj(objPtr, w);
+ objResultPtr = objPtr;
+ }
+ goto doneIncr;
+ }
+ }
+ DECACHE_STACK_INFO();
+ if (isWide) {
+ objResultPtr = TclPtrIncrWideVar(interp, varPtr, arrayPtr, part1,
+ part2, w, TCL_LEAVE_ERR_MSG);
+ } else {
+ objResultPtr = TclPtrIncrVar(interp, varPtr, arrayPtr, part1,
+ part2, i, TCL_LEAVE_ERR_MSG);
+ }
+ CACHE_STACK_INFO();
+ if (objResultPtr == NULL) {
+ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+ doneIncr:
+ TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
#ifndef TCL_COMPILE_DEBUG
- if (*(pc+pcAdjustment) == INST_POP) {
- NEXT_INST_V((pcAdjustment+1), cleanup, 0);
- }
+ if (*(pc+pcAdjustment) == INST_POP) {
+ NEXT_INST_V((pcAdjustment+1), cleanup, 0);
+ }
#endif
- NEXT_INST_V(pcAdjustment, cleanup, 1);
-
+ NEXT_INST_V(pcAdjustment, cleanup, 1);
+ }
+
/*
* End of INST_INCR instructions.
* ---------------------------------------------------------
@@ -2346,87 +2393,114 @@ TclExecuteByteCode(interp, codePtr)
case INST_JUMP1:
- opnd = TclGetInt1AtPtr(pc+1);
- TRACE(("%d => new pc %u\n", opnd,
- (unsigned int)(pc + opnd - codePtr->codeStart)));
- NEXT_INST_F(opnd, 0, 0);
+ {
+ int opnd;
+
+ opnd = TclGetInt1AtPtr(pc+1);
+ TRACE(("%d => new pc %u\n", opnd,
+ (unsigned int)(pc + opnd - codePtr->codeStart)));
+ NEXT_INST_F(opnd, 0, 0);
+ }
case INST_JUMP4:
- opnd = TclGetInt4AtPtr(pc+1);
- TRACE(("%d => new pc %u\n", opnd,
- (unsigned int)(pc + opnd - codePtr->codeStart)));
- NEXT_INST_F(opnd, 0, 0);
-
- case INST_JUMP_FALSE4:
- opnd = 5; /* TRUE */
- pcAdjustment = TclGetInt4AtPtr(pc+1); /* FALSE */
- goto doJumpTrue;
-
- case INST_JUMP_TRUE4:
- opnd = TclGetInt4AtPtr(pc+1); /* TRUE */
- pcAdjustment = 5; /* FALSE */
- goto doJumpTrue;
-
- case INST_JUMP_FALSE1:
- opnd = 2; /* TRUE */
- pcAdjustment = TclGetInt1AtPtr(pc+1); /* FALSE */
- goto doJumpTrue;
-
- case INST_JUMP_TRUE1:
- opnd = TclGetInt1AtPtr(pc+1); /* TRUE */
- pcAdjustment = 2; /* FALSE */
+ {
+ int opnd;
+
+ opnd = TclGetInt4AtPtr(pc+1);
+ TRACE(("%d => new pc %u\n", opnd,
+ (unsigned int)(pc + opnd - codePtr->codeStart)));
+ NEXT_INST_F(opnd, 0, 0);
+ }
+
+ {
+ int trueJmp, falseJmp;
+
+
+ case INST_JUMP_FALSE4:
+ trueJmp = 5;
+ falseJmp = TclGetInt4AtPtr(pc+1);
+ goto doJumpTrue;
- doJumpTrue:
- {
- int b;
+ case INST_JUMP_TRUE4:
+ trueJmp = TclGetInt4AtPtr(pc+1);
+ falseJmp = 5;
+ goto doJumpTrue;
+
+ case INST_JUMP_FALSE1:
+ trueJmp = 2;
+ falseJmp = TclGetInt1AtPtr(pc+1);
+ goto doJumpTrue;
+
+ case INST_JUMP_TRUE1:
+ trueJmp = TclGetInt1AtPtr(pc+1);
+ falseJmp = 2;
+
+ doJumpTrue:
+ {
+ int b;
+ Tcl_Obj *valuePtr;
- valuePtr = *tosPtr;
- /*
- * The following will be partially resolved at compile
- * time and optimised away.
- */
- if (((sizeof(long) == sizeof(int)) &&
- (valuePtr->typePtr == &tclIntType))
- || (valuePtr->typePtr == &tclBooleanType)) {
- b = (int) valuePtr->internalRep.longValue;
- } else if ((sizeof(long) != sizeof(int)) &&
+ valuePtr = *tosPtr;
+
+ /*
+ * The following will be partially resolved at compile
+ * time and optimised away.
+ */
+ if (((sizeof(long) == sizeof(int)) &&
+ (valuePtr->typePtr == &tclIntType))
+ || (valuePtr->typePtr == &tclBooleanType)) {
+ b = (int) valuePtr->internalRep.longValue;
+ } else if ((sizeof(long) != sizeof(int)) &&
(valuePtr->typePtr == &tclIntType)) {
- b = (valuePtr->internalRep.longValue != 0);
- } else if (valuePtr->typePtr == &tclDoubleType) {
- b = (valuePtr->internalRep.doubleValue != 0.0);
- } else if (valuePtr->typePtr == &tclWideIntType) {
- TclGetWide(w,valuePtr);
- b = (w != W0);
- } else {
- result = Tcl_GetBooleanFromObj(interp, valuePtr, &b);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
- goto checkForCatch;
+ b = (valuePtr->internalRep.longValue != 0);
+ } else if (valuePtr->typePtr == &tclDoubleType) {
+ b = (valuePtr->internalRep.doubleValue != 0.0);
+ } else if (valuePtr->typePtr == &tclWideIntType) {
+ Tcl_WideInt w;
+
+ TclGetWide(w,valuePtr);
+ b = (w != W0);
+ } else {
+ /*
+ * Taking b's address impedes it being a register
+ * variable (in gcc at least), so we avoid doing it.
+
+ */
+ int b1;
+ result = Tcl_GetBooleanFromObj(interp, valuePtr, &b1);
+ if (result != TCL_OK) {
+ if ((*pc == INST_JUMP_FALSE1) || (*pc == INST_JUMP_FALSE4)) {
+ trueJmp = falseJmp;
+ }
+ TRACE_WITH_OBJ(("%d => ERROR: ", trueJmp), Tcl_GetObjResult(interp));
+ goto checkForCatch;
+ }
+ b = b1;
}
- }
#ifndef TCL_COMPILE_DEBUG
- NEXT_INST_F((b? opnd : pcAdjustment), 1, 0);
+ NEXT_INST_F((b? trueJmp : falseJmp), 1, 0);
#else
- if (b) {
- if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
- TRACE(("%d => %.20s true, new pc %u\n", opnd, O2S(valuePtr),
- (unsigned int)(pc+opnd - codePtr->codeStart)));
- } else {
- TRACE(("%d => %.20s true\n", pcAdjustment, O2S(valuePtr)));
- }
- NEXT_INST_F(opnd, 1, 0);
- } else {
- if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
- TRACE(("%d => %.20s false\n", opnd, O2S(valuePtr)));
+ if (b) {
+ if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
+ TRACE(("%d => %.20s true, new pc %u\n", trueJmp, O2S(valuePtr),
+ (unsigned int)(pc+trueJmp - codePtr->codeStart)));
+ } else {
+ TRACE(("%d => %.20s true\n", falseJmp, O2S(valuePtr)));
+ }
+ NEXT_INST_F(trueJmp, 1, 0);
} else {
- opnd = pcAdjustment;
- TRACE(("%d => %.20s false, new pc %u\n", opnd, O2S(valuePtr),
- (unsigned int)(pc + opnd - codePtr->codeStart)));
+ if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
+ TRACE(("%d => %.20s false\n", falseJmp, O2S(valuePtr)));
+ } else {
+ opnd = pcAdjustment;
+ TRACE(("%d => %.20s false, new pc %u\n", falseJmp, O2S(valuePtr),
+ (unsigned int)(pc + falseJmp - codePtr->codeStart)));
+ }
+ NEXT_INST_F(falseJmp, 1, 0);
}
- NEXT_INST_F(pcAdjustment, 1, 0);
- }
#endif
- }
+ }
+ }
/*
* These two instructions are now redundant: the complete logic of the
@@ -2441,15 +2515,17 @@ TclExecuteByteCode(interp, codePtr)
* conversions are performed.
*/
- int i1, i2;
+ int i1, i2, length;
int iResult;
char *s;
Tcl_ObjType *t1Ptr, *t2Ptr;
-
+ Tcl_Obj *valuePtr, *value2Ptr;
+
value2Ptr = *tosPtr;
valuePtr = *(tosPtr - 1);
t1Ptr = valuePtr->typePtr;
t2Ptr = value2Ptr->typePtr;
+ Tcl_WideInt w;
if ((t1Ptr == &tclIntType) || (t1Ptr == &tclBooleanType)) {
i1 = (valuePtr->internalRep.longValue != 0);
@@ -2461,6 +2537,8 @@ TclExecuteByteCode(interp, codePtr)
} else {
s = Tcl_GetStringFromObj(valuePtr, &length);
if (TclLooksLikeInt(s, length)) {
+ long i = 0;
+
GET_WIDE_OR_INT(result, valuePtr, i, w);
if (valuePtr->typePtr == &tclIntType) {
i1 = (i != 0);
@@ -2492,6 +2570,8 @@ TclExecuteByteCode(interp, codePtr)
} else {
s = Tcl_GetStringFromObj(value2Ptr, &length);
if (TclLooksLikeInt(s, length)) {
+ long i = 0;
+
GET_WIDE_OR_INT(result, value2Ptr, i, w);
if (value2Ptr->typePtr == &tclIntType) {
i2 = (i != 0);
@@ -2537,63 +2617,76 @@ TclExecuteByteCode(interp, codePtr)
*/
case INST_LIST:
- /*
- * Pop the opnd (objc) top stack elements into a new list obj
- * and then decrement their ref counts.
- */
-
- opnd = TclGetUInt4AtPtr(pc+1);
- objResultPtr = Tcl_NewListObj(opnd, (tosPtr - (opnd-1)));
- TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
- NEXT_INST_V(5, opnd, 1);
+ {
+ /*
+ * Pop the opnd (objc) top stack elements into a new list obj
+ * and then decrement their ref counts.
+ */
+ int opnd;
+
+ opnd = TclGetUInt4AtPtr(pc+1);
+ objResultPtr = Tcl_NewListObj(opnd, (tosPtr - (opnd-1)));
+ TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
+ NEXT_INST_V(5, opnd, 1);
+ }
case INST_LIST_LENGTH:
- valuePtr = *tosPtr;
+ {
+ Tcl_Obj *valuePtr;
+ int length;
+
+ valuePtr = *tosPtr;
- result = Tcl_ListObjLength(interp, valuePtr, &length);
- if (result != TCL_OK) {
- TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
- Tcl_GetObjResult(interp));
- goto checkForCatch;
+ result = Tcl_ListObjLength(interp, valuePtr, &length);
+ if (result != TCL_OK) {
+ TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
+ Tcl_GetObjResult(interp));
+ goto checkForCatch;
+ }
+ objResultPtr = Tcl_NewIntObj(length);
+ TRACE(("%.20s => %d\n", O2S(valuePtr), length));
+ NEXT_INST_F(1, 1, 1);
}
- objResultPtr = Tcl_NewIntObj(length);
- TRACE(("%.20s => %d\n", O2S(valuePtr), length));
- NEXT_INST_F(1, 1, 1);
case INST_LIST_INDEX:
- /*** lindex with objc == 3 ***/
-
- /*
- * Pop the two operands
- */
- value2Ptr = *tosPtr;
- valuePtr = *(tosPtr - 1);
+ {
+ /*** lindex with objc == 3 ***/
- /*
- * Extract the desired list element
- */
- objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
- if (objResultPtr == NULL) {
- TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ", O2S(valuePtr), O2S(value2Ptr)),
- Tcl_GetObjResult(interp));
- result = TCL_ERROR;
- goto checkForCatch;
+ Tcl_Obj *valuePtr, *value2Ptr;
+
+ /*
+ * Pop the two operands
+ */
+ value2Ptr = *tosPtr;
+ valuePtr = *(tosPtr - 1);
+
+ /*
+ * Extract the desired list element
+ */
+ objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
+ if (objResultPtr == NULL) {
+ TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ", O2S(valuePtr), O2S(value2Ptr)),
+ Tcl_GetObjResult(interp));
+ result = TCL_ERROR;
+ goto checkForCatch;
+ }
+
+ /*
+ * Stash the list element on the stack
+ */
+ TRACE(("%.20s %.20s => %s\n",
+ O2S(valuePtr), O2S(value2Ptr), O2S(objResultPtr)));
+ NEXT_INST_F(1, 2, -1); /* already has the correct refCount */
}
- /*
- * Stash the list element on the stack
- */
- TRACE(("%.20s %.20s => %s\n",
- O2S(valuePtr), O2S(value2Ptr), O2S(objResultPtr)));
- NEXT_INST_F(1, 2, -1); /* already has the correct refCount */
-
case INST_LIST_INDEX_IMM:
{
/*** lindex with objc==3 and index in bytecode stream ***/
- int listc, idx;
+ int listc, idx, opnd;
Tcl_Obj **listv;
-
+ Tcl_Obj *valuePtr;
+
/*
* Pop the list and get the index
*/
@@ -2638,7 +2731,7 @@ TclExecuteByteCode(interp, codePtr)
* Determine the count of index args.
*/
- int numIdx;
+ int numIdx, opnd;
opnd = TclGetUInt4AtPtr(pc+1);
numIdx = opnd-1;
@@ -2671,7 +2764,8 @@ TclExecuteByteCode(interp, codePtr)
* Lset with 3, 5, or more args. Get the number
* of index args.
*/
- int numIdx;
+ int numIdx,opnd;
+ Tcl_Obj *valuePtr, *value2Ptr;
opnd = TclGetUInt4AtPtr( pc + 1 );
numIdx = opnd - 2;
@@ -2713,9 +2807,14 @@ TclExecuteByteCode(interp, codePtr)
}
case INST_LSET_LIST:
+ {
/*
* 'lset' with 4 args.
- *
+ */
+
+ Tcl_Obj *objPtr, *valuePtr, *value2Ptr;
+
+ /*
* Get the old value of variable, and remove the stack ref.
* This is safe because the variable still references the
* object; the ref count will never go zero here.
@@ -2749,14 +2848,16 @@ TclExecuteByteCode(interp, codePtr)
*/
TRACE(("=> %s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, -1);
-
+ }
+
case INST_LIST_RANGE_IMM:
{
/*** lrange with objc==4 and both indices in bytecode stream ***/
int listc, fromIdx, toIdx;
Tcl_Obj **listv;
-
+ Tcl_Obj *valuePtr;
+
/*
* Pop the list and get the indices
*/
@@ -2838,6 +2939,7 @@ TclExecuteByteCode(interp, codePtr)
* String (in)equality check
*/
int iResult;
+ Tcl_Obj *valuePtr, *value2Ptr;
value2Ptr = *tosPtr;
valuePtr = *(tosPtr - 1);
@@ -2901,7 +3003,8 @@ TclExecuteByteCode(interp, codePtr)
*/
CONST char *s1, *s2;
int s1len, s2len, iResult;
-
+ Tcl_Obj *valuePtr, *value2Ptr;
+
value2Ptr = *tosPtr;
valuePtr = *(tosPtr - 1);
@@ -2970,17 +3073,18 @@ TclExecuteByteCode(interp, codePtr)
case INST_STR_LEN:
{
- int length1;
+ int length;
+ Tcl_Obj *valuePtr;
valuePtr = *tosPtr;
if (valuePtr->typePtr == &tclByteArrayType) {
- (void) Tcl_GetByteArrayFromObj(valuePtr, &length1);
+ (void) Tcl_GetByteArrayFromObj(valuePtr, &length);
} else {
- length1 = Tcl_GetCharLength(valuePtr);
+ length = Tcl_GetCharLength(valuePtr);
}
- objResultPtr = Tcl_NewIntObj(length1);
- TRACE(("%.20s => %d\n", O2S(valuePtr), length1));
+ objResultPtr = Tcl_NewIntObj(length);
+ TRACE(("%.20s => %d\n", O2S(valuePtr), length));
NEXT_INST_F(1, 1, 1);
}
@@ -2989,9 +3093,11 @@ TclExecuteByteCode(interp, codePtr)
/*
* String compare
*/
- int index;
+ int index, length;
+ char *bytes;
bytes = NULL; /* lint */
-
+ Tcl_Obj *valuePtr, *value2Ptr;
+
value2Ptr = *tosPtr;
valuePtr = *(tosPtr - 1);
@@ -3049,6 +3155,7 @@ TclExecuteByteCode(interp, codePtr)
case INST_STR_MATCH:
{
int nocase, match;
+ Tcl_Obj *valuePtr, *value2Ptr;
nocase = TclGetInt1AtPtr(pc+1);
valuePtr = *tosPtr; /* String */
@@ -3107,7 +3214,11 @@ TclExecuteByteCode(interp, codePtr)
double d1 = 0.0; /* Init. avoids compiler warning. */
double d2 = 0.0; /* Init. avoids compiler warning. */
long iResult = 0; /* Init. avoids compiler warning. */
-
+ Tcl_Obj *valuePtr, *value2Ptr;
+ int length;
+ Tcl_WideInt w;
+ long i;
+
value2Ptr = *tosPtr;
valuePtr = *(tosPtr - 1);
@@ -3333,11 +3444,12 @@ TclExecuteByteCode(interp, codePtr)
* Only integers are allowed. We compute value op value2.
*/
- long i2 = 0, rem, negative;
+ long i = 0, i2 = 0, rem, negative;
long iResult = 0; /* Init. avoids compiler warning. */
- Tcl_WideInt w2, wResult = W0;
+ Tcl_WideInt w, w2, wResult = W0;
int doWide = 0;
-
+ Tcl_Obj *valuePtr, *value2Ptr;
+
value2Ptr = *tosPtr;
valuePtr = *(tosPtr - 1);
if (valuePtr->typePtr == &tclIntType) {
@@ -3574,15 +3686,17 @@ TclExecuteByteCode(interp, codePtr)
*/
Tcl_ObjType *t1Ptr, *t2Ptr;
- long i2 = 0, quot, rem; /* Init. avoids compiler warning. */
+ long i = 0, i2 = 0, quot, rem; /* Init. avoids compiler warning. */
double d1, d2;
long iResult = 0; /* Init. avoids compiler warning. */
double dResult = 0.0; /* Init. avoids compiler warning. */
int doDouble = 0; /* 1 if doing floating arithmetic */
- Tcl_WideInt w2, wquot, wrem;
+ Tcl_WideInt w, w2, wquot, wrem;
Tcl_WideInt wResult = W0; /* Init. avoids compiler warning. */
int doWide = 0; /* 1 if doing wide arithmetic. */
-
+ Tcl_Obj *valuePtr,*value2Ptr;
+ int length;
+
value2Ptr = *tosPtr;
valuePtr = *(tosPtr - 1);
t1Ptr = valuePtr->typePtr;
@@ -3851,7 +3965,8 @@ TclExecuteByteCode(interp, codePtr)
double d;
Tcl_ObjType *tPtr;
-
+ Tcl_Obj *valuePtr;
+
valuePtr = *tosPtr;
tPtr = valuePtr->typePtr;
if (IS_INTEGER_TYPE(tPtr)
@@ -3867,7 +3982,11 @@ TclExecuteByteCode(interp, codePtr)
* Otherwise, we need to generate a numeric internal rep.
* from the string rep.
*/
+ int length;
+ long i;
+ Tcl_WideInt w;
char *s = Tcl_GetStringFromObj(valuePtr, &length);
+
if (TclLooksLikeInt(s, length)) {
GET_WIDE_OR_INT(result, valuePtr, i, w);
} else {
@@ -3895,14 +4014,14 @@ TclExecuteByteCode(interp, codePtr)
if (Tcl_IsShared(valuePtr)) {
if (tPtr == &tclIntType) {
- i = valuePtr->internalRep.longValue;
- objResultPtr = Tcl_NewLongObj(i);
+ objResultPtr = Tcl_NewLongObj(valuePtr->internalRep.longValue);
} else if (tPtr == &tclWideIntType) {
+ Tcl_WideInt w;
+
TclGetWide(w,valuePtr);
objResultPtr = Tcl_NewWideIntObj(w);
} else {
- d = valuePtr->internalRep.doubleValue;
- objResultPtr = Tcl_NewDoubleObj(d);
+ objResultPtr = Tcl_NewDoubleObj(valuePtr->internalRep.doubleValue);
}
TRACE_WITH_OBJ(("%s => ", O2S(objResultPtr)), objResultPtr);
NEXT_INST_F(1, 1, 1);
@@ -3927,8 +4046,11 @@ TclExecuteByteCode(interp, codePtr)
double d;
int boolvar;
+ long i;
+ Tcl_WideInt w;
Tcl_ObjType *tPtr;
-
+ Tcl_Obj *valuePtr;
+
valuePtr = *tosPtr;
tPtr = valuePtr->typePtr;
if (IS_INTEGER_TYPE(tPtr)
@@ -3947,6 +4069,7 @@ TclExecuteByteCode(interp, codePtr)
if ((tPtr == &tclBooleanType) && (valuePtr->bytes == NULL)) {
valuePtr->typePtr = &tclIntType;
} else {
+ int length;
char *s = Tcl_GetStringFromObj(valuePtr, &length);
if (TclLooksLikeInt(s, length)) {
GET_WIDE_OR_INT(result, valuePtr, i, w);
@@ -4046,7 +4169,10 @@ TclExecuteByteCode(interp, codePtr)
*/
Tcl_ObjType *tPtr;
-
+ Tcl_Obj *valuePtr;
+ Tcl_WideInt w;
+ long i;
+
valuePtr = *tosPtr;
tPtr = valuePtr->typePtr;
if (!IS_INTEGER_TYPE(tPtr)) {
@@ -4093,14 +4219,15 @@ TclExecuteByteCode(interp, codePtr)
}
case INST_CALL_BUILTIN_FUNC1:
- opnd = TclGetUInt1AtPtr(pc+1);
- {
+ {
+ int opnd;
+ BuiltinFunc *mathFuncPtr;
+
/*
* Call one of the built-in Tcl math functions.
*/
- BuiltinFunc *mathFuncPtr;
-
+ opnd = TclGetUInt1AtPtr(pc+1);
if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
Tcl_Panic("TclExecuteByteCode: unrecognized builtin function code %d", opnd);
@@ -4117,18 +4244,18 @@ TclExecuteByteCode(interp, codePtr)
NEXT_INST_F(2, 0, 0);
case INST_CALL_FUNC1:
- opnd = TclGetUInt1AtPtr(pc+1);
{
/*
* Call a non-builtin Tcl math function previously
* registered by a call to Tcl_CreateMathFunc.
*/
- int objc = opnd; /* Number of arguments. The function name
+ int objc; /* Number of arguments. The function name
* is the 0-th argument. */
Tcl_Obj **objv; /* The array of arguments. The function
* name is objv[0]. */
+ objc = TclGetUInt1AtPtr(pc+1);
objv = (tosPtr - (objc-1)); /* "objv[0]" */
DECACHE_STACK_INFO();
result = ExprCallMathFunc(interp, objc, objv);
@@ -4153,8 +4280,11 @@ TclExecuteByteCode(interp, codePtr)
double d;
char *s;
Tcl_ObjType *tPtr;
- int converted, needNew;
-
+ int converted, needNew, length;
+ Tcl_Obj *valuePtr;
+ long i;
+ Tcl_WideInt w;
+
valuePtr = *tosPtr;
tPtr = valuePtr->typePtr;
converted = 0;
@@ -4270,19 +4400,25 @@ TclExecuteByteCode(interp, codePtr)
goto processExceptionReturn;
case INST_FOREACH_START4:
- opnd = TclGetUInt4AtPtr(pc+1);
{
/*
* Initialize the temporary local var that holds the count
* of the number of iterations of the loop body to -1.
*/
- ForeachInfo *infoPtr = (ForeachInfo *)
- codePtr->auxDataArrayPtr[opnd].clientData;
- int iterTmpIndex = infoPtr->loopCtTemp;
- Var *iterVarPtr = &(compiledLocals[iterTmpIndex]);
- Tcl_Obj *oldValuePtr = iterVarPtr->value.objPtr;
+ int opnd;
+ ForeachInfo *infoPtr;
+ int iterTmpIndex;
+ Var *iterVarPtr;
+ Tcl_Obj *oldValuePtr;
+ opnd = TclGetUInt4AtPtr(pc+1);
+ infoPtr = (ForeachInfo *)
+ codePtr->auxDataArrayPtr[opnd].clientData;
+ iterTmpIndex = infoPtr->loopCtTemp;
+ iterVarPtr = &(compiledLocals[iterTmpIndex]);
+ oldValuePtr = iterVarPtr->value.objPtr;
+
if (oldValuePtr == NULL) {
iterVarPtr->value.objPtr = Tcl_NewLongObj(-1);
Tcl_IncrRefCount(iterVarPtr->value.objPtr);
@@ -4307,22 +4443,29 @@ TclExecuteByteCode(interp, codePtr)
NEXT_INST_F(5, 0, 0);
#endif
case INST_FOREACH_STEP4:
- opnd = TclGetUInt4AtPtr(pc+1);
{
/*
* "Step" a foreach loop (i.e., begin its next iteration) by
* assigning the next value list element to each loop var.
*/
- ForeachInfo *infoPtr = (ForeachInfo *)
- codePtr->auxDataArrayPtr[opnd].clientData;
+ int opnd;
+ ForeachInfo *infoPtr;
ForeachVarList *varListPtr;
- int numLists = infoPtr->numLists;
- Tcl_Obj *listPtr;
+ int numLists;
+ Tcl_Obj *listPtr,*valuePtr, *value2Ptr;
List *listRepPtr;
Var *iterVarPtr, *listVarPtr;
int iterNum, listTmpIndex, listLen, numVars;
int varIndex, valIndex, continueLoop, j;
+ long i;
+ Var *varPtr;
+ char *part1;
+
+ opnd = TclGetUInt4AtPtr(pc+1);
+ infoPtr = (ForeachInfo *)
+ codePtr->auxDataArrayPtr[opnd].clientData;
+ numLists = infoPtr->numLists;
/*
* Increment the temp holding the loop iteration number.
@@ -4519,187 +4662,205 @@ TclExecuteByteCode(interp, codePtr)
goto checkForCatch;
/*
- * An external evaluation (INST_INVOKE or INST_EVAL) returned
- * something different from TCL_OK, or else INST_BREAK or
- * INST_CONTINUE were called.
+ * Block for variables needed to process exception returns
*/
+
+ {
- processExceptionReturn:
+ ExceptionRange *rangePtr; /* Points to closest loop or catch
+ * exception range enclosing the pc. Used
+ * by various instructions and processCatch
+ * to process break, continue, and
+ * errors. */
+ Tcl_Obj *valuePtr;
+ char *bytes;
+ int length;
+
+
+ /*
+ * An external evaluation (INST_INVOKE or INST_EVAL) returned
+ * something different from TCL_OK, or else INST_BREAK or
+ * INST_CONTINUE were called.
+ */
+
+ processExceptionReturn:
#if TCL_COMPILE_DEBUG
- switch (*pc) {
- case INST_INVOKE_STK1:
- case INST_INVOKE_STK4:
- TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf));
- break;
- case INST_EVAL_STK:
+ switch (*pc) {
+ case INST_INVOKE_STK1:
+ case INST_INVOKE_STK4:
+ TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf));
+ break;
+ case INST_EVAL_STK:
/*
* Note that the object at stacktop has to be used
* before doing the cleanup.
*/
-
- TRACE(("\"%.30s\" => ", O2S(*tosPtr)));
- break;
- default:
- TRACE(("=> "));
- }
+
+ TRACE(("\"%.30s\" => ", O2S(*tosPtr)));
+ break;
+ default:
+ TRACE(("=> "));
+ }
#endif
- if ((result == TCL_CONTINUE) || (result == TCL_BREAK)) {
- rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0, codePtr);
- if (rangePtr == NULL) {
- TRACE_APPEND(("no encl. loop or catch, returning %s\n",
- StringForResultCode(result)));
- goto abnormalReturn;
- }
- if (rangePtr->type == CATCH_EXCEPTION_RANGE) {
- TRACE_APPEND(("%s ...\n", StringForResultCode(result)));
- goto processCatch;
- }
- while (cleanup--) {
- valuePtr = POP_OBJECT();
- TclDecrRefCount(valuePtr);
- }
- if (result == TCL_BREAK) {
- result = TCL_OK;
- pc = (codePtr->codeStart + rangePtr->breakOffset);
- TRACE_APPEND(("%s, range at %d, new pc %d\n",
- StringForResultCode(result),
- rangePtr->codeOffset, rangePtr->breakOffset));
- NEXT_INST_F(0, 0, 0);
- } else {
- if (rangePtr->continueOffset == -1) {
- TRACE_APPEND(("%s, loop w/o continue, checking for catch\n",
- StringForResultCode(result)));
- goto checkForCatch;
+ if ((result == TCL_CONTINUE) || (result == TCL_BREAK)) {
+ rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 0, codePtr);
+ if (rangePtr == NULL) {
+ TRACE_APPEND(("no encl. loop or catch, returning %s\n",
+ StringForResultCode(result)));
+ goto abnormalReturn;
}
- result = TCL_OK;
- pc = (codePtr->codeStart + rangePtr->continueOffset);
- TRACE_APPEND(("%s, range at %d, new pc %d\n",
- StringForResultCode(result),
- rangePtr->codeOffset, rangePtr->continueOffset));
- NEXT_INST_F(0, 0, 0);
- }
+ if (rangePtr->type == CATCH_EXCEPTION_RANGE) {
+ TRACE_APPEND(("%s ...\n", StringForResultCode(result)));
+ goto processCatch;
+ }
+ while (cleanup--) {
+ valuePtr = POP_OBJECT();
+ TclDecrRefCount(valuePtr);
+ }
+ if (result == TCL_BREAK) {
+ result = TCL_OK;
+ pc = (codePtr->codeStart + rangePtr->breakOffset);
+ TRACE_APPEND(("%s, range at %d, new pc %d\n",
+ StringForResultCode(result),
+ rangePtr->codeOffset, rangePtr->breakOffset));
+ NEXT_INST_F(0, 0, 0);
+ } else {
+ if (rangePtr->continueOffset == -1) {
+ TRACE_APPEND(("%s, loop w/o continue, checking for catch\n",
+ StringForResultCode(result)));
+ goto checkForCatch;
+ }
+ result = TCL_OK;
+ pc = (codePtr->codeStart + rangePtr->continueOffset);
+ TRACE_APPEND(("%s, range at %d, new pc %d\n",
+ StringForResultCode(result),
+ rangePtr->codeOffset, rangePtr->continueOffset));
+ NEXT_INST_F(0, 0, 0);
+ }
#if TCL_COMPILE_DEBUG
- } else if (traceInstructions) {
- if ((result != TCL_ERROR) && (result != TCL_RETURN)) {
- objPtr = Tcl_GetObjResult(interp);
- TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ",
- result, O2S(objPtr)));
- } else {
- objPtr = Tcl_GetObjResult(interp);
- TRACE_APPEND(("%s, result= \"%s\"\n",
- StringForResultCode(result), O2S(objPtr)));
- }
+ } else if (traceInstructions) {
+ if ((result != TCL_ERROR) && (result != TCL_RETURN)) {
+ objPtr = Tcl_GetObjResult(interp);
+ TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ",
+ result, O2S(objPtr)));
+ } else {
+ objPtr = Tcl_GetObjResult(interp);
+ TRACE_APPEND(("%s, result= \"%s\"\n",
+ StringForResultCode(result), O2S(objPtr)));
+ }
#endif
- }
-
- /*
- * Execution has generated an "exception" such as TCL_ERROR. If the
- * exception is an error, record information about what was being
- * executed when the error occurred. Find the closest enclosing
- * catch range, if any. If no enclosing catch range is found, stop
- * execution and return the "exception" code.
- */
+ }
- checkForCatch:
- if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
- bytes = GetSrcInfoForPc(pc, codePtr, &length);
- if (bytes != NULL) {
- DECACHE_STACK_INFO();
- Tcl_LogCommandInfo(interp, codePtr->source, bytes, length);
- CACHE_STACK_INFO();
- iPtr->flags |= ERR_ALREADY_LOGGED;
+ /*
+ * Execution has generated an "exception" such as TCL_ERROR. If the
+ * exception is an error, record information about what was being
+ * executed when the error occurred. Find the closest enclosing
+ * catch range, if any. If no enclosing catch range is found, stop
+ * execution and return the "exception" code.
+ */
+
+ checkForCatch:
+ if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+ bytes = GetSrcInfoForPc(pc, codePtr, &length);
+ if (bytes != NULL) {
+ DECACHE_STACK_INFO();
+ Tcl_LogCommandInfo(interp, codePtr->source, bytes, length);
+ CACHE_STACK_INFO();
+ iPtr->flags |= ERR_ALREADY_LOGGED;
+ }
}
- }
- /*
- * We must not catch an exceeded limit. Instead, it blows
- * outwards until we either hit another interpreter (presumably
- * where the limit is not exceeded) or we get to the top-level.
- */
- if (Tcl_LimitExceeded(interp)) {
+ /*
+ * We must not catch an exceeded limit. Instead, it blows
+ * outwards until we either hit another interpreter (presumably
+ * where the limit is not exceeded) or we get to the top-level.
+ */
+ if (Tcl_LimitExceeded(interp)) {
#ifdef TCL_COMPILE_DEBUG
- if (traceInstructions) {
- fprintf(stdout, " ... limit exceeded, returning %s\n",
- StringForResultCode(result));
- }
+ if (traceInstructions) {
+ fprintf(stdout, " ... limit exceeded, returning %s\n",
+ StringForResultCode(result));
+ }
#endif
- goto abnormalReturn;
- }
- if (catchTop == initCatchTop) {
+ goto abnormalReturn;
+ }
+ if (catchTop == initCatchTop) {
#ifdef TCL_COMPILE_DEBUG
- if (traceInstructions) {
- fprintf(stdout, " ... no enclosing catch, returning %s\n",
- StringForResultCode(result));
+ if (traceInstructions) {
+ fprintf(stdout, " ... no enclosing catch, returning %s\n",
+ StringForResultCode(result));
+ }
+#endif
+ goto abnormalReturn;
}
+ rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 1, codePtr);
+ if (rangePtr == NULL) {
+ /*
+ * This is only possible when compiling a [catch] that sends its
+ * 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",
+ StringForResultCode(result));
+ }
#endif
- goto abnormalReturn;
- }
- rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 1, codePtr);
- if (rangePtr == NULL) {
+ goto abnormalReturn;
+ }
+
/*
- * This is only possible when compiling a [catch] that sends its
- * script to INST_EVAL. Cannot correct the compiler without
- * breakingcompat with previous .tbc compiled scripts.
+ * A catch exception range (rangePtr) was found to handle an
+ * "exception". It was found either by checkForCatch just above or
+ * by an instruction during break, continue, or error processing.
+ * Jump to its catchOffset after unwinding the operand stack to
+ * the depth it had when starting to execute the range's catch
+ * command.
*/
-#ifdef TCL_COMPILE_DEBUG
- if (traceInstructions) {
- fprintf(stdout, " ... no enclosing catch, returning %s\n",
- StringForResultCode(result));
- }
-#endif
- goto abnormalReturn;
- }
-
- /*
- * A catch exception range (rangePtr) was found to handle an
- * "exception". It was found either by checkForCatch just above or
- * by an instruction during break, continue, or error processing.
- * Jump to its catchOffset after unwinding the operand stack to
- * the depth it had when starting to execute the range's catch
- * command.
- */
-
- processCatch:
- while (tosPtr > (int) (eePtr->stackPtr[catchTop]) + eePtr->stackPtr) {
- valuePtr = POP_OBJECT();
- TclDecrRefCount(valuePtr);
- }
-#ifdef TCL_COMPILE_DEBUG
- if (traceInstructions) {
- fprintf(stdout, " ... found catch at %d, catchTop=%d, unwound to %d, new pc %u\n",
- rangePtr->codeOffset, (catchTop - initCatchTop - 1),
- (int) eePtr->stackPtr[catchTop],
- (unsigned int)(rangePtr->catchOffset));
- }
-#endif
- pc = (codePtr->codeStart + rangePtr->catchOffset);
- NEXT_INST_F(0, 0, 0); /* restart the execution loop at pc */
- /*
- * end of infinite loop dispatching on instructions.
- */
-
- /*
- * Abnormal return code. Restore the stack to state it had when starting
- * to execute the ByteCode. Panic if the stack is below the initial level.
- */
-
- abnormalReturn:
- {
- Tcl_Obj **initTosPtr = eePtr->stackPtr + initStackTop;
- while (tosPtr > initTosPtr) {
+ processCatch:
+ while (tosPtr > (int) (eePtr->stackPtr[catchTop]) + eePtr->stackPtr) {
valuePtr = POP_OBJECT();
TclDecrRefCount(valuePtr);
}
- 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) (tosPtr - eePtr->stackPtr),
- (unsigned int) initStackTop);
- Tcl_Panic("TclExecuteByteCode execution failure: end stack top < start stack top");
+#ifdef TCL_COMPILE_DEBUG
+ if (traceInstructions) {
+ fprintf(stdout, " ... found catch at %d, catchTop=%d, unwound to %d, new pc %u\n",
+ rangePtr->codeOffset, (catchTop - initCatchTop - 1),
+ (int) eePtr->stackPtr[catchTop],
+ (unsigned int)(rangePtr->catchOffset));
+ }
+#endif
+ pc = (codePtr->codeStart + rangePtr->catchOffset);
+ NEXT_INST_F(0, 0, 0); /* restart the execution loop at pc */
+
+ /*
+ * end of infinite loop dispatching on instructions.
+ */
+
+ /*
+ * Abnormal return code. Restore the stack to state it had when starting
+ * to execute the ByteCode. Panic if the stack is below the initial level.
+ */
+
+ abnormalReturn:
+ {
+ Tcl_Obj **initTosPtr = eePtr->stackPtr + initStackTop;
+ while (tosPtr > initTosPtr) {
+ valuePtr = POP_OBJECT();
+ TclDecrRefCount(valuePtr);
+ }
+ 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) (tosPtr - eePtr->stackPtr),
+ (unsigned int) initStackTop);
+ Tcl_Panic("TclExecuteByteCode execution failure: end stack top < start stack top");
+ }
+ eePtr->tosPtr = initTosPtr - codePtr->maxExceptDepth;
}
- eePtr->tosPtr = initTosPtr - codePtr->maxExceptDepth;
}
return result;
+#undef iPtr
}
#ifdef TCL_COMPILE_DEBUG