summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2007-06-05 18:12:40 (GMT)
committerdgp <dgp@users.sourceforge.net>2007-06-05 18:12:40 (GMT)
commit5d472b8fabc1189e2cfb79e315f743b0c8a02c5b (patch)
tree96e1584742499ed8ea59f529779deaa0b65bd167 /generic
parent4802c9d106e1fe0f7aa7156a6e9dc681066d52ed (diff)
downloadtcl-5d472b8fabc1189e2cfb79e315f743b0c8a02c5b.zip
tcl-5d472b8fabc1189e2cfb79e315f743b0c8a02c5b.tar.gz
tcl-5d472b8fabc1189e2cfb79e315f743b0c8a02c5b.tar.bz2
merge updates from HEAD
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c3
-rw-r--r--generic/tclExecute.c460
-rw-r--r--generic/tclInt.h27
-rw-r--r--generic/tclNamesp.c6
-rw-r--r--generic/tclProc.c5
-rw-r--r--generic/tclResult.c19
6 files changed, 319 insertions, 201 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 99b4809..60f7bb8 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.244.2.1 2007/05/30 18:38:43 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.244.2.2 2007/06/05 18:12:41 dgp Exp $
*/
#include "tclInt.h"
@@ -5227,6 +5227,7 @@ Tcl_AddObjErrorInfo(
* the error message in the interpreter's result.
*/
+ iPtr->flags |= ERR_LEGACY_COPY;
if (iPtr->errorInfo == NULL) {
if (iPtr->result[0] != 0) {
/*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index c1f6a3a..18ea0b2 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -12,7 +12,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.285 2007/05/17 13:45:27 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.285.2.1 2007/06/05 18:12:41 dgp Exp $
*/
#include "tclInt.h"
@@ -183,11 +183,10 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
*/
#define CACHE_STACK_INFO() \
- tosPtr = eePtr->tosPtr;\
checkInterp = 1
#define DECACHE_STACK_INFO() \
- eePtr->tosPtr = tosPtr
+ esPtr->tosPtr = tosPtr
/*
* Macros used to access items on the Tcl evaluation stack. PUSH_OBJECT
@@ -215,7 +214,7 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
#define OBJ_AT_DEPTH(n) *(tosPtr-(n))
-#define CURR_DEPTH (tosPtr-eePtr->stackPtr)
+#define CURR_DEPTH (tosPtr - initTosPtr)
/*
* Macros used to trace instruction execution. The macros TRACE,
@@ -389,7 +388,7 @@ static ExceptionRange * GetExceptRangeForPc(unsigned char *pc, int catchOnly,
ByteCode *codePtr);
static const char * GetSrcInfoForPc(unsigned char *pc, ByteCode *codePtr,
int *lengthPtr);
-static void GrowEvaluationStack(ExecEnv *eePtr, int growth);
+static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, int growth, int move);
static void IllegalExprOperandType(Tcl_Interp *interp,
unsigned char *pc, Tcl_Obj *opndPtr);
static void InitByteCodeExecution(Tcl_Interp *interp);
@@ -400,6 +399,17 @@ static void ValidatePcAndStackTop(ByteCode *codePtr,
unsigned char *pc, int stackTop,
int stackLowerBound, int checkStack);
#endif /* TCL_COMPILE_DEBUG */
+
+static void DeleteExecStack(ExecStack *esPtr);
+
+/* Useful elsewhere, make available in tclInt.h or stubs? */
+static Tcl_Obj ** StackAllocWords(Tcl_Interp *interp, int numWords);
+static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, int numWords);
+
+/* Move to internal stubs? For now, unused */
+extern char * TclStackRealloc(Tcl_Interp *interp, int numBytes);
+
+
/*
*----------------------------------------------------------------------
@@ -470,28 +480,22 @@ TclCreateExecEnv(
* environment is being created. */
{
ExecEnv *eePtr = (ExecEnv *) ckalloc(sizeof(ExecEnv));
- Tcl_Obj **stackPtr;
-
- stackPtr = (Tcl_Obj **)
- ckalloc((size_t) (TCL_STACK_INITIAL_SIZE * sizeof(Tcl_Obj *)));
-
- /*
- * Use the bottom pointer to keep a reference count; the execution
- * environment holds a reference.
- */
-
- stackPtr++;
- eePtr->stackPtr = stackPtr;
- stackPtr[-1] = (Tcl_Obj *) ((char *) 1);
-
- eePtr->tosPtr = stackPtr - 1;
- eePtr->endPtr = stackPtr + (TCL_STACK_INITIAL_SIZE - 2);
+ ExecStack *esPtr = (ExecStack *)
+ ckalloc((size_t) (sizeof(ExecStack)
+ + (TCL_STACK_INITIAL_SIZE -1) * sizeof(Tcl_Obj *)));
+ eePtr->execStackPtr = esPtr;
TclNewBooleanObj(eePtr->constants[0], 0);
Tcl_IncrRefCount(eePtr->constants[0]);
TclNewBooleanObj(eePtr->constants[1], 1);
Tcl_IncrRefCount(eePtr->constants[1]);
+ esPtr->prevPtr = NULL;
+ esPtr->nextPtr = NULL;
+ esPtr->markerPtr = NULL;
+ esPtr->endPtr = &esPtr->stackWords[TCL_STACK_INITIAL_SIZE-1];
+ esPtr->tosPtr = &esPtr->stackWords[-1];
+
Tcl_MutexLock(&execMutex);
if (!execInitialized) {
TclInitAuxDataTypeTable();
@@ -521,15 +525,42 @@ TclCreateExecEnv(
*----------------------------------------------------------------------
*/
+static void
+DeleteExecStack(
+ ExecStack *esPtr)
+{
+ if (esPtr->markerPtr) {
+ Tcl_Panic("freeing an execStack which is still in use");
+ }
+
+ if (esPtr->prevPtr) {
+ esPtr->prevPtr->nextPtr = esPtr->nextPtr;
+ }
+ if (esPtr->nextPtr) {
+ esPtr->nextPtr->prevPtr = esPtr->prevPtr;
+ }
+ ckfree((char *) esPtr);
+}
+
void
TclDeleteExecEnv(
ExecEnv *eePtr) /* Execution environment to free. */
{
- if (eePtr->stackPtr[-1] == (Tcl_Obj *) ((char *) 1)) {
- ckfree((char *) (eePtr->stackPtr-1));
- } else {
- Tcl_Panic("freeing an execEnv whose stack is still in use");
+ ExecStack *esPtr = eePtr->execStackPtr, *tmpPtr;
+
+ /*
+ * Delete all stacks in this exec env.
+ */
+
+ while (esPtr->nextPtr) {
+ esPtr = esPtr->nextPtr;
}
+ while (esPtr) {
+ tmpPtr = esPtr;
+ esPtr = tmpPtr->prevPtr;
+ DeleteExecStack(tmpPtr);
+ }
+
TclDecrRefCount(eePtr->constants[0]);
TclDecrRefCount(eePtr->constants[1]);
ckfree((char *) eePtr);
@@ -567,67 +598,122 @@ TclFinalizeExecution(void)
*
* GrowEvaluationStack --
*
- * This procedure grows a Tcl evaluation stack stored in an ExecEnv.
+ * This procedure grows a Tcl evaluation stack stored in an ExecEnv,
+ * copying over the words since the last mark if so requested. A mark is
+ * set at the beginning of the new area when no copying is requested.
*
* Results:
- * None.
+ * Returns a pointer to the first usable word in the (possibly) grown
+ * stack.
*
* Side effects:
- * The size of the evaluation stack is grown.
+ * The size of the evaluation stack may be grown, a marker is set
*
*----------------------------------------------------------------------
*/
-static void
+static Tcl_Obj **
GrowEvaluationStack(
- ExecEnv *eePtr, /* Points to the ExecEnv with an evaluation
- * stack to enlarge. */
- int growth)
+ ExecEnv *eePtr, /* Points to the ExecEnv with an evaluation
+ * stack to enlarge. */
+ int growth, /* How much larger than the current used size */
+ int move) /* 1 if move words since last marker */
{
- Tcl_Obj **newStackPtr, **oldStackPtr = eePtr->stackPtr;
- int currElems, newBytes, newElems;
- int needed = growth - (eePtr->endPtr - eePtr->tosPtr);
- char *refCount;
-
- if (needed <= 0) {
- return;
+ ExecStack *esPtr = eePtr->execStackPtr, *oldPtr = NULL;
+ int newBytes, newElems;
+ int needed = growth - (esPtr->endPtr - esPtr->tosPtr);
+ int currElems;
+ Tcl_Obj **markerPtr = esPtr->markerPtr;
+
+ if (move) {
+ if (!markerPtr) {
+ Tcl_Panic("STACK: Reallocating with no previous alloc");
+ }
+ if (needed <= 0) {
+ return (markerPtr+1);
+ }
+ } else if (needed < 0) {
+ esPtr->markerPtr = ++esPtr->tosPtr;
+ *esPtr->markerPtr = (Tcl_Obj *) markerPtr;
+ return (esPtr->markerPtr+1);
}
/*
- * The current Tcl stack elements are stored from *(eePtr->stackPtr) to
- * *(eePtr->endPtr) (inclusive).
+ * Reset move to hold the number of words to be moved to new stack (if
+ * any) and growth to hold the complete stack requirements.
*/
- currElems = (eePtr->endPtr - eePtr->stackPtr + 1);
+ if (move) {
+ move = esPtr->tosPtr - markerPtr;
+ }
+ needed = growth + move + 1; /* add the marker */
+
+ /*
+ * Check if there is enough room in the next stack (if there is one, it
+ * should be both empty and the last one!)
+ */
+
+ if (esPtr->nextPtr) {
+ oldPtr = esPtr;
+ esPtr = oldPtr->nextPtr;
+ currElems = esPtr->endPtr - &esPtr->stackWords[-1];
+ if (esPtr->markerPtr || (esPtr->tosPtr != &esPtr->stackWords[-1])) {
+ Tcl_Panic("STACK: Stack after current is in use");
+ }
+ if (esPtr->nextPtr) {
+ Tcl_Panic("STACK: Stack after current is not last");
+ }
+ if (needed <= currElems) {
+ goto newStackReady;
+ } else {
+ DeleteExecStack(esPtr);
+ esPtr = oldPtr;
+ }
+ } else {
+ currElems = esPtr->endPtr - &esPtr->stackWords[-1];
+ }
+
+ /*
+ * We need to allocate a new stack! It needs to store 'growth' words,
+ * including the elements to be copied over and the new marker.
+ */
+
newElems = 2*currElems;
- while (needed > newElems - currElems) {
+ while (needed > newElems) {
newElems *= 2;
}
- newBytes = newElems * sizeof(Tcl_Obj *);
+ newBytes = sizeof (ExecStack) + (newElems-1) * sizeof(Tcl_Obj *);
+
+ oldPtr = esPtr;
+ esPtr = (ExecStack *) ckalloc(newBytes);
+
+ oldPtr->nextPtr = esPtr;
+ esPtr->prevPtr = oldPtr;
+ esPtr->nextPtr = NULL;
+ esPtr->endPtr = &esPtr->stackWords[newElems-1];
+
+ newStackReady:
+ eePtr->execStackPtr = esPtr;
+
+ esPtr->stackWords[0] = NULL;
+ esPtr->markerPtr = esPtr->tosPtr = &esPtr->stackWords[0];
+
+ if (move) {
+ memcpy(&esPtr->stackWords[1], (markerPtr+1), move*sizeof(Tcl_Obj *));
+ esPtr->tosPtr += move;
+ oldPtr->markerPtr = (Tcl_Obj **) *markerPtr;
+ oldPtr->tosPtr = markerPtr-1;
+ }
/*
- * We keep the stack reference count as a (char *), as that works nicely
- * as a portable pointer-sized counter.
+ * Free the old stack if it is now unused.
*/
-
- refCount = (char *) oldStackPtr[-1];
- if (refCount == (char *) 1) {
- newStackPtr = (Tcl_Obj **) ckrealloc(
- (char *) (oldStackPtr - 1), newBytes);
- newStackPtr++;
- } else {
- /* Can't free oldStackPtr, so can't use ckrealloc */
- int currBytes = currElems * sizeof(Tcl_Obj *);
- newStackPtr = (Tcl_Obj **) ckalloc(newBytes);
- newStackPtr++;
- memcpy(newStackPtr, oldStackPtr, currBytes);
- oldStackPtr[-1] = (Tcl_Obj *) (refCount-1);
- newStackPtr[-1] = (Tcl_Obj *) ((char *) 1);
+
+ if (!oldPtr->markerPtr) {
+ DeleteExecStack(oldPtr);
}
- eePtr->stackPtr = newStackPtr;
- eePtr->endPtr = newStackPtr + (newElems-2); /* index of last usable item */
- eePtr->tosPtr = newStackPtr + (eePtr->tosPtr - oldStackPtr);
+ return &esPtr->stackWords[1];
}
/*
@@ -648,41 +734,30 @@ GrowEvaluationStack(
*--------------------------------------------------------------
*/
-char *
-TclStackAlloc(
+static Tcl_Obj **
+StackAllocWords(
Tcl_Interp *interp,
- int numBytes)
+ int numWords)
{
Interp *iPtr = (Interp *) interp;
ExecEnv *eePtr = iPtr->execEnvPtr;
+ Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 0);
- /*
- * Add two words to store
- * - a pointer to the used execution stack
- * - the number of words reserved
- * These will be used later by TclStackFree.
- */
-
- int numWords = (numBytes + 3*sizeof(void *) - 1)/sizeof(void *);
- Tcl_Obj **tosPtr = (GrowEvaluationStack(eePtr, numWords), eePtr->tosPtr);
-
- /*
- * Increase the stack's reference count, to make sure it is not freed
- * prematurely.
- */
-
- char **stackRefCountPtr = (char **) (eePtr->stackPtr-1);
- ++*stackRefCountPtr;
-
- /*
- * Reserve the space in the exec stack, and store the data for freeing.
- */
+ eePtr->execStackPtr->tosPtr += numWords;
+ return resPtr;
+}
- eePtr->tosPtr += numWords;
- *(eePtr->tosPtr-1) = (Tcl_Obj *) stackRefCountPtr;
- *(eePtr->tosPtr) = (Tcl_Obj *) INT2PTR(numWords);
+static Tcl_Obj **
+StackReallocWords(
+ Tcl_Interp *interp,
+ int numWords)
+{
+ Interp *iPtr = (Interp *) interp;
+ ExecEnv *eePtr = iPtr->execEnvPtr;
+ Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 1);
- return (char *) (tosPtr+1);
+ eePtr->execStackPtr->tosPtr += numWords;
+ return resPtr;
}
void
@@ -691,15 +766,49 @@ TclStackFree(
{
Interp *iPtr = (Interp *) interp;
ExecEnv *eePtr = iPtr->execEnvPtr;
- char **stackRefCountPtr;
-
- stackRefCountPtr = (char **) *(eePtr->tosPtr-1);
- eePtr->tosPtr -= PTR2INT(*(eePtr->tosPtr));
-
- --*stackRefCountPtr;
- if (*stackRefCountPtr == (char *) 0) {
- ckfree((char *) stackRefCountPtr);
+ ExecStack *esPtr = eePtr->execStackPtr;
+ Tcl_Obj **markerPtr = esPtr->markerPtr;
+
+ esPtr->tosPtr = markerPtr-1;
+ esPtr->markerPtr = (Tcl_Obj **) *markerPtr;
+ if (*markerPtr) {
+ return;
+ }
+
+ /*
+ * Return to previous stack.
+ */
+
+ esPtr->tosPtr = &esPtr->stackWords[-1];
+ if (esPtr->prevPtr) {
+ eePtr->execStackPtr = esPtr->prevPtr;
}
+ if (esPtr->nextPtr) {
+ if (!esPtr->prevPtr) {
+ eePtr->execStackPtr = esPtr->nextPtr;
+ }
+ DeleteExecStack(esPtr);
+ }
+}
+
+char *
+TclStackAlloc(
+ Tcl_Interp *interp,
+ int numBytes)
+{
+ int numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
+
+ return (char *) StackAllocWords(interp, numWords);
+}
+
+char *
+TclStackRealloc(
+ Tcl_Interp *interp,
+ int numBytes)
+{
+ int numWords = (numBytes + sizeof(void *) - 1)/sizeof(void *);
+
+ return (char *) StackReallocWords(interp, numWords);
}
/*
@@ -1194,18 +1303,19 @@ TclExecuteByteCode(
* sporadically.
*/
- ExecEnv *eePtr; /* Points to the execution environment. */
- int initStackDepth; /* Stack top at start of execution. */
- int initCatchTop; /* Catch stack top at start of execution. */
+ ExecStack *esPtr;
+ Tcl_Obj **initTosPtr; /* Stack top at start of execution. */
+ ptrdiff_t *initCatchTop; /* Catch stack top at start of execution. */
Var *compiledLocals;
Namespace *namespacePtr;
CmdFrame bcFrame; /* TIP #280: Structure for tracking lines. */
+ Tcl_Obj **constants = &iPtr->execEnvPtr->constants[0];
/*
* Globals: variables that store state, must remain valid at all times.
*/
- int catchTop;
+ ptrdiff_t *catchTop;
register Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation
* stack. */
register unsigned char *pc = codePtr->codeStart;
@@ -1214,7 +1324,7 @@ TclExecuteByteCode(
* call Tcl_AsyncReady() */
Tcl_Obj *expandNestList = NULL;
int checkInterp = 0; /* Indicates when a check of interp readyness
- * is necessary. Set by DECACHE_STACK_INFO() */
+ * is necessary. Set by CACHE_STACK_INFO() */
/*
* Transfer variables - needed only between opcodes, but not while
@@ -1252,16 +1362,12 @@ TclExecuteByteCode(
* execution stack is large enough to execute this ByteCode.
*/
- eePtr = iPtr->execEnvPtr;
- initCatchTop = eePtr->tosPtr - eePtr->stackPtr;
- catchTop = initCatchTop;
-
- GrowEvaluationStack(eePtr,
- codePtr->maxExceptDepth + codePtr->maxStackDepth);
- tosPtr = eePtr->tosPtr + codePtr->maxExceptDepth;
-
- initStackDepth = CURR_DEPTH;
-
+ catchTop = initCatchTop =
+ (ptrdiff_t *) (GrowEvaluationStack(iPtr->execEnvPtr,
+ codePtr->maxExceptDepth + codePtr->maxStackDepth, 0) - 1);
+ tosPtr = initTosPtr = ((Tcl_Obj **) initCatchTop) + codePtr->maxExceptDepth;
+ esPtr = iPtr->execEnvPtr->execStackPtr;
+
/*
* TIP #280: Initialize the frame. Do not push it yet.
*/
@@ -1282,7 +1388,7 @@ TclExecuteByteCode(
#ifdef TCL_COMPILE_DEBUG
if (tclTraceExec >= 2) {
PrintByteCodeInfo(codePtr);
- fprintf(stdout, " Starting stack top=%d\n", initStackDepth);
+ fprintf(stdout, " Starting stack top=%d\n", CURR_DEPTH);
fflush(stdout);
}
#endif
@@ -1373,7 +1479,7 @@ TclExecuteByteCode(
*/
ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH,
- initStackDepth, /*checkStack*/ (expandNestList == NULL));
+ 0, /*checkStack*/ (expandNestList == NULL));
if (traceInstructions) {
fprintf(stdout, "%2d: %2d ", iPtr->numLevels, (int) CURR_DEPTH);
TclPrintInstruction(codePtr, pc);
@@ -1458,7 +1564,7 @@ TclExecuteByteCode(
}
case INST_DONE:
- if (CURR_DEPTH > initStackDepth) {
+ if (tosPtr > initTosPtr) {
/*
* Set the interpreter's object result to point to the topmost
* object from the stack, and check for a possible [catch]. The
@@ -1690,8 +1796,8 @@ TclExecuteByteCode(
*/
Tcl_Obj *objPtr;
-
- TclNewObj(objPtr);
+
+ TclNewObj(objPtr);
objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) CURR_DEPTH;
objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) expandNestList;
expandNestList = objPtr;
@@ -1701,6 +1807,7 @@ TclExecuteByteCode(
case INST_EXPAND_STKTOP: {
int objc, length, i;
Tcl_Obj **objv, *valuePtr;
+ ptrdiff_t moved;
/*
* Make sure that the element at stackTop is a list; if not, just
@@ -1724,10 +1831,22 @@ TclExecuteByteCode(
* stack depth, as seen by the compiler.
*/
- length = objc + codePtr->maxStackDepth - TclGetInt4AtPtr(pc+1);
+ length = objc + (codePtr->maxStackDepth - TclGetInt4AtPtr(pc+1));
DECACHE_STACK_INFO();
- GrowEvaluationStack(eePtr, length);
- CACHE_STACK_INFO();
+ moved = (GrowEvaluationStack(iPtr->execEnvPtr, length, 1) - 1)
+ - (Tcl_Obj **) initCatchTop;
+
+ if (moved) {
+ /*
+ * Change the global data to point to the new stack.
+ */
+
+ initCatchTop += moved;
+ catchTop += moved;
+ initTosPtr += moved;
+ tosPtr += moved;
+ esPtr = iPtr->execEnvPtr->execStackPtr;
+ }
/*
* Expand the list at stacktop onto the stack; free the list. Knowing
@@ -1787,13 +1906,6 @@ TclExecuteByteCode(
const char *bytes;
Command *cmdPtr;
- /*
- * 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) {
int i;
@@ -1815,17 +1927,6 @@ TclExecuteByteCode(
#endif /*TCL_COMPILE_DEBUG*/
/*
- * 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.
*/
@@ -1880,17 +1981,6 @@ TclExecuteByteCode(
CACHE_STACK_INFO();
iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
- /*
- * 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((char *) preservedStackRefCountPtr);
- }
-
if (result == TCL_OK) {
Tcl_Obj *objPtr;
@@ -2871,7 +2961,7 @@ TclExecuteByteCode(
valuePtr = OBJ_AT_TOS;
/* TODO - check claim that taking address of b harms performance */
- /* TODO - consider optimization search for eePtr->constants */
+ /* TODO - consider optimization search for constants */
result = TclGetBooleanFromObj(interp, valuePtr, &b);
if (result != TCL_OK) {
TRACE_WITH_OBJ(("%d => ERROR: ", jmpOffset[
@@ -2963,7 +3053,7 @@ TclExecuteByteCode(
} else {
iResult = (i1 && i2);
}
- objResultPtr = eePtr->constants[iResult];
+ objResultPtr = constants[iResult];
TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
NEXT_INST_F(1, 2, 1);
}
@@ -3371,7 +3461,7 @@ TclExecuteByteCode(
NEXT_INST_F((found ? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
}
#endif
- objResultPtr = eePtr->constants[found];
+ objResultPtr = constants[found];
NEXT_INST_F(0, 2, 1);
}
@@ -3442,7 +3532,7 @@ TclExecuteByteCode(
NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
}
#endif
- objResultPtr = eePtr->constants[iResult];
+ objResultPtr = constants[iResult];
NEXT_INST_F(0, 2, 1);
}
@@ -3547,7 +3637,7 @@ TclExecuteByteCode(
TclNewIntObj(objResultPtr, -1);
TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), -1));
} else {
- objResultPtr = eePtr->constants[(iResult>0)];
+ objResultPtr = constants[(iResult>0)];
TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr),
(iResult > 0)));
}
@@ -3669,7 +3759,7 @@ TclExecuteByteCode(
*/
TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));
- objResultPtr = eePtr->constants[match];
+ objResultPtr = constants[match];
NEXT_INST_F(2, 2, 1);
}
@@ -3986,7 +4076,7 @@ TclExecuteByteCode(
NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
}
#endif
- objResultPtr = eePtr->constants[iResult];
+ objResultPtr = constants[iResult];
NEXT_INST_F(0, 2, 1);
}
@@ -4038,7 +4128,7 @@ TclExecuteByteCode(
* Div. by |1| always yields remainder of 0
*/
- objResultPtr = eePtr->constants[0];
+ objResultPtr = constants[0];
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
}
@@ -4050,7 +4140,7 @@ TclExecuteByteCode(
* 0 % (non-zero) always yields remainder of 0
*/
- objResultPtr = eePtr->constants[0];
+ objResultPtr = constants[0];
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
}
@@ -4261,7 +4351,7 @@ TclExecuteByteCode(
if ((type1 == TCL_NUMBER_LONG) && (*((const long *)ptr1) == (long)0)) {
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
- objResultPtr = eePtr->constants[0];
+ objResultPtr = constants[0];
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
}
@@ -4360,7 +4450,7 @@ TclExecuteByteCode(
zero = 0;
}
if (zero) {
- objResultPtr = eePtr->constants[0];
+ objResultPtr = constants[0];
} else {
TclNewIntObj(objResultPtr, -1);
}
@@ -4377,7 +4467,7 @@ TclExecuteByteCode(
l1 = *((const long *)ptr1);
if ((size_t)shift >= CHAR_BIT*sizeof(long)) {
if (l1 >= (long)0) {
- objResultPtr = eePtr->constants[0];
+ objResultPtr = constants[0];
} else {
TclNewIntObj(objResultPtr, -1);
}
@@ -4398,7 +4488,7 @@ TclExecuteByteCode(
if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) {
if (w >= (Tcl_WideInt)0) {
- objResultPtr = eePtr->constants[0];
+ objResultPtr = constants[0];
} else {
TclNewIntObj(objResultPtr, -1);
}
@@ -5106,7 +5196,7 @@ TclExecuteByteCode(
* Anything to the zero power is 1.
*/
- objResultPtr = eePtr->constants[1];
+ objResultPtr = constants[1];
NEXT_INST_F(1, 2, 1);
}
}
@@ -5153,7 +5243,7 @@ TclExecuteByteCode(
if (oddExponent) {
TclNewIntObj(objResultPtr, -1);
} else {
- objResultPtr = eePtr->constants[1];
+ objResultPtr = constants[1];
}
NEXT_INST_F(1, 2, 1);
case 1:
@@ -5161,7 +5251,7 @@ TclExecuteByteCode(
* 1 to any power is 1.
*/
- objResultPtr = eePtr->constants[1];
+ objResultPtr = constants[1];
NEXT_INST_F(1, 2, 1);
}
}
@@ -5171,7 +5261,7 @@ TclExecuteByteCode(
* power yield the answer zero (see TIP 123).
*/
- objResultPtr = eePtr->constants[0];
+ objResultPtr = constants[0];
NEXT_INST_F(1, 2, 1);
}
@@ -5183,20 +5273,20 @@ TclExecuteByteCode(
* Zero to a positive power is zero.
*/
- objResultPtr = eePtr->constants[0];
+ objResultPtr = constants[0];
NEXT_INST_F(1, 2, 1);
case 1:
/*
* 1 to any power is 1.
*/
- objResultPtr = eePtr->constants[1];
+ objResultPtr = constants[1];
NEXT_INST_F(1, 2, 1);
case -1:
if (oddExponent) {
TclNewIntObj(objResultPtr, -1);
} else {
- objResultPtr = eePtr->constants[1];
+ objResultPtr = constants[1];
}
NEXT_INST_F(1, 2, 1);
}
@@ -5370,7 +5460,7 @@ TclExecuteByteCode(
Tcl_Obj *valuePtr = OBJ_AT_TOS;
/* TODO - check claim that taking address of b harms performance */
- /* TODO - consider optimization search for eePtr->constants */
+ /* TODO - consider optimization search for constants */
result = TclGetBooleanFromObj(NULL, valuePtr, &b);
if (result != TCL_OK) {
TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", O2S(valuePtr),
@@ -5379,7 +5469,7 @@ TclExecuteByteCode(
goto checkForCatch;
}
/* TODO: Consider peephole opt. */
- objResultPtr = eePtr->constants[!b];
+ objResultPtr = constants[!b];
NEXT_INST_F(1, 1, 1);
}
@@ -5813,7 +5903,7 @@ TclExecuteByteCode(
* to the operand. Push the current stack depth onto the special catch
* stack.
*/
- eePtr->stackPtr[++catchTop] = (Tcl_Obj *) CURR_DEPTH;
+ *(++catchTop) = CURR_DEPTH;
TRACE(("%u => catchTop=%d, stackTop=%d\n",
TclGetUInt4AtPtr(pc+1), (catchTop - initCatchTop - 1),
(int) CURR_DEPTH));
@@ -6185,7 +6275,7 @@ TclExecuteByteCode(
}
TRACE_APPEND(("\"%.30s\" \"%.30s\" %d",
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));
- objResultPtr = eePtr->constants[done];
+ objResultPtr = constants[done];
/* TODO: consider opt like INST_FOREACH_STEP4 */
NEXT_INST_F(5, 0, 1);
@@ -6509,9 +6599,10 @@ TclExecuteByteCode(
*/
while ((expandNestList != NULL) && ((catchTop == initCatchTop) ||
- ((ptrdiff_t) eePtr->stackPtr[catchTop] <=
+ (*catchTop <=
(ptrdiff_t) expandNestList->internalRep.twoPtrValue.ptr1))) {
Tcl_Obj *objPtr = expandNestList->internalRep.twoPtrValue.ptr2;
+
TclDecrRefCount(expandNestList);
expandNestList = objPtr;
}
@@ -6565,7 +6656,7 @@ TclExecuteByteCode(
*/
processCatch:
- while (CURR_DEPTH > ((ptrdiff_t) (eePtr->stackPtr[catchTop]))) {
+ while (CURR_DEPTH > *catchTop) {
valuePtr = POP_OBJECT();
TclDecrRefCount(valuePtr);
}
@@ -6573,7 +6664,7 @@ TclExecuteByteCode(
if (traceInstructions) {
fprintf(stdout, " ... found catch at %d, catchTop=%d, unwound to %ld, new pc %u\n",
rangePtr->codeOffset, (catchTop - initCatchTop - 1),
- (long) eePtr->stackPtr[catchTop],
+ (long) *catchTop,
(unsigned int)(rangePtr->catchOffset));
}
#endif
@@ -6592,7 +6683,7 @@ TclExecuteByteCode(
abnormalReturn:
{
- while (CURR_DEPTH > initStackDepth) {
+ while (tosPtr > initTosPtr) {
Tcl_Obj *objPtr = POP_OBJECT();
Tcl_DecrRefCount(objPtr);
}
@@ -6606,16 +6697,21 @@ TclExecuteByteCode(
TclDecrRefCount(expandNestList);
expandNestList = objPtr;
}
- if (CURR_DEPTH < initStackDepth) {
+ if (tosPtr < initTosPtr) {
fprintf(stderr, "\nTclExecuteByteCode: abnormal return at pc %u: stack top %d < entry stack top %d\n",
(unsigned int)(pc - codePtr->codeStart),
(unsigned int) CURR_DEPTH,
- (unsigned int) initStackDepth);
+ (unsigned int) 0);
Tcl_Panic("TclExecuteByteCode execution failure: end stack top < start stack top");
}
- eePtr->tosPtr = eePtr->stackPtr + initStackDepth - codePtr->maxExceptDepth;
}
}
+
+ /*
+ * Restore the stack to the state it had previous to this bytecode.
+ */
+
+ TclStackFree(interp);
return result;
#undef iPtr
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 4ba7cff..1d8a81e 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.310.2.1 2007/05/30 18:38:46 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.310.2.2 2007/06/05 18:12:42 dgp Exp $
*/
#ifndef _TCLINT
@@ -1183,20 +1183,30 @@ typedef int (CompileHookProc) (Tcl_Interp *interp,
struct CompileEnv *compEnvPtr, ClientData clientData);
/*
+ * The data structure for a (linked list of) execution stacks.
+ */
+
+typedef struct ExecStack {
+ struct ExecStack *prevPtr;
+ struct ExecStack *nextPtr;
+ Tcl_Obj **markerPtr;
+ Tcl_Obj **endPtr;
+ Tcl_Obj **tosPtr;
+ Tcl_Obj *stackWords[1];
+} ExecStack;
+
+
+/*
* The data structure defining the execution environment for ByteCode's.
* There is one ExecEnv structure per Tcl interpreter. It holds the evaluation
* stack that holds command operands and results. The stack grows towards
- * increasing addresses. The "stackTop" member is cached by TclExecuteByteCode
- * in a local variable: it must be set before calling TclExecuteByteCode and
- * will be restored by TclExecuteByteCode before it returns.
+ * increasing addresses. The member stackPtr points to the stackItems of the
+ * currently active execution stack.
*/
typedef struct ExecEnv {
- Tcl_Obj **stackPtr; /* Points to the first item in the evaluation
+ ExecStack *execStackPtr; /* Points to the first item in the evaluation
* stack on the heap. */
- Tcl_Obj **tosPtr; /* Points to current top of stack;
- * (stackPtr-1) when the stack is empty. */
- Tcl_Obj **endPtr; /* Points to last usable item in stack. */
Tcl_Obj *constants[2]; /* Pointers to constant "0" and "1" objs. */
} ExecEnv;
@@ -1838,6 +1848,7 @@ typedef struct InterpList {
#define SAFE_INTERP 0x80
#define INTERP_TRACE_IN_PROGRESS 0x200
#define INTERP_ALTERNATE_WRONG_ARGS 0x400
+#define ERR_LEGACY_COPY 0x800
/*
* Maximum number of levels of nesting permitted in Tcl commands (used to
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index c090271..9141750 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -22,7 +22,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclNamesp.c,v 1.134 2007/05/07 19:45:33 dgp Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.134.2.1 2007/06/05 18:12:42 dgp Exp $
*/
#include "tclInt.h"
@@ -622,7 +622,7 @@ ErrorCodeRead(
{
Interp *iPtr = (Interp *)interp;
- if (Tcl_InterpDeleted(interp)) {
+ if (Tcl_InterpDeleted(interp) || !(iPtr->flags & ERR_LEGACY_COPY)) {
return NULL;
}
if (iPtr->errorCode) {
@@ -696,7 +696,7 @@ ErrorInfoRead(
{
Interp *iPtr = (Interp *)interp;
- if (Tcl_InterpDeleted(interp)) {
+ if (Tcl_InterpDeleted(interp) || !(iPtr->flags & ERR_LEGACY_COPY)) {
return NULL;
}
if (iPtr->errorInfo) {
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 51b18115..456e4c8 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.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: tclProc.c,v 1.115 2007/05/11 09:17:01 dkf Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.115.2.1 2007/06/05 18:12:42 dgp Exp $
*/
#include "tclInt.h"
@@ -2026,6 +2026,9 @@ TclUpdateReturnInfo(
*/
code = iPtr->returnCode;
+ if (code == TCL_ERROR) {
+ iPtr->flags |= ERR_LEGACY_COPY;
+ }
}
return code;
}
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 9512989..a9b2b070 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclResult.c,v 1.36 2007/04/20 06:10:58 kennykb Exp $
+ * RCS: @(#) $Id: tclResult.c,v 1.36.2.1 2007/06/05 18:12:42 dgp Exp $
*/
#include "tclInt.h"
@@ -906,15 +906,19 @@ Tcl_ResetResult(
iPtr->resultSpace[0] = 0;
if (iPtr->errorCode) {
/* Legacy support */
- Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL,
- iPtr->errorCode, TCL_GLOBAL_ONLY);
+ if (iPtr->flags & ERR_LEGACY_COPY) {
+ Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL,
+ iPtr->errorCode, TCL_GLOBAL_ONLY);
+ }
Tcl_DecrRefCount(iPtr->errorCode);
iPtr->errorCode = NULL;
}
if (iPtr->errorInfo) {
/* Legacy support */
- Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL,
- iPtr->errorInfo, TCL_GLOBAL_ONLY);
+ if (iPtr->flags & ERR_LEGACY_COPY) {
+ Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL,
+ iPtr->errorInfo, TCL_GLOBAL_ONLY);
+ }
Tcl_DecrRefCount(iPtr->errorInfo);
iPtr->errorInfo = NULL;
}
@@ -924,7 +928,7 @@ Tcl_ResetResult(
Tcl_DecrRefCount(iPtr->returnOpts);
iPtr->returnOpts = NULL;
}
- iPtr->flags &= ~ERR_ALREADY_LOGGED;
+ iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_LEGACY_COPY);
}
/*
@@ -1237,6 +1241,9 @@ TclProcessReturn(
iPtr->returnCode = code;
return TCL_RETURN;
}
+ if (code == TCL_ERROR) {
+ iPtr->flags |= ERR_LEGACY_COPY;
+ }
return code;
}