diff options
author | dgp <dgp@users.sourceforge.net> | 2007-06-05 18:12:40 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2007-06-05 18:12:40 (GMT) |
commit | 5d472b8fabc1189e2cfb79e315f743b0c8a02c5b (patch) | |
tree | 96e1584742499ed8ea59f529779deaa0b65bd167 /generic | |
parent | 4802c9d106e1fe0f7aa7156a6e9dc681066d52ed (diff) | |
download | tcl-5d472b8fabc1189e2cfb79e315f743b0c8a02c5b.zip tcl-5d472b8fabc1189e2cfb79e315f743b0c8a02c5b.tar.gz tcl-5d472b8fabc1189e2cfb79e315f743b0c8a02c5b.tar.bz2 |
merge updates from HEAD
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclBasic.c | 3 | ||||
-rw-r--r-- | generic/tclExecute.c | 460 | ||||
-rw-r--r-- | generic/tclInt.h | 27 | ||||
-rw-r--r-- | generic/tclNamesp.c | 6 | ||||
-rw-r--r-- | generic/tclProc.c | 5 | ||||
-rw-r--r-- | generic/tclResult.c | 19 |
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; } |