summaryrefslogtreecommitdiffstats
path: root/generic/tclExecute.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r--generic/tclExecute.c642
1 files changed, 102 insertions, 540 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 26d3e04..b340144 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -171,19 +171,21 @@ static BuiltinFunc const tclBuiltinFuncTable[] = {
typedef struct TEBCdata {
ByteCode *codePtr; /* Constant until the BC returns */
/* -----------------------------------------*/
+ Tcl_Obj **tosPtr;
const unsigned char *pc; /* These fields are used on return TO this */
- ptrdiff_t *catchTop; /* this level: they record the state when a */
+ int catchDepth; /* this level: they record the state when a */
int cleanup; /* new codePtr was received for NR */
Tcl_Obj *auxObjList; /* execution. */
int checkInterp;
CmdFrame cmdFrame;
+ unsigned int capacity;
void * stack[1]; /* Start of the actual combined catch and obj
* stacks; the struct will be expanded as
* necessary */
} TEBCdata;
#define TEBC_YIELD() \
- esPtr->tosPtr = tosPtr; \
+ TD->tosPtr = tosPtr; \
TD->pc = pc; \
TD->cleanup = cleanup; \
TclNRAddCallback(interp, TEBCresume, TD, \
@@ -192,7 +194,7 @@ typedef struct TEBCdata {
#define TEBC_DATA_DIG() \
pc = TD->pc; \
cleanup = TD->cleanup; \
- tosPtr = esPtr->tosPtr
+ tosPtr = TD->tosPtr
#define PUSH_TAUX_OBJ(objPtr) \
@@ -296,20 +298,6 @@ VarHashCreateVar(
} while (0)
/*
- * Macros used to cache often-referenced Tcl evaluation stack information
- * in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO()
- * pair must surround any call inside TclNRExecuteByteCode (and a few other
- * procedures that use this scheme) that could result in a recursive call
- * to TclNRExecuteByteCode.
- */
-
-#define CACHE_STACK_INFO() \
- checkInterp = 1
-
-#define DECACHE_STACK_INFO() \
- esPtr->tosPtr = tosPtr
-
-/*
* Macros used to access items on the Tcl evaluation stack. PUSH_OBJECT
* increments the object's ref count since it makes the stack have another
* reference pointing to the object. However, POP_OBJECT does not decrement
@@ -683,7 +671,6 @@ static void ValidatePcAndStackTop(ByteCode *codePtr,
int stackLowerBound, int checkStack);
#endif /* TCL_COMPILE_DEBUG */
static ByteCode * CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
-static void DeleteExecStack(ExecStack *esPtr);
static void DupExprCodeInternalRep(Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr);
MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr,
@@ -699,16 +686,10 @@ static ExceptionRange * GetExceptRangeForPc(const unsigned char *pc,
static const char * GetSrcInfoForPc(const unsigned char *pc,
ByteCode *codePtr, int *lengthPtr,
const unsigned char **pcBeg);
-static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, int growth,
- int move);
static void IllegalExprOperandType(Tcl_Interp *interp,
const unsigned char *pc, Tcl_Obj *opndPtr);
static void InitByteCodeExecution(Tcl_Interp *interp);
-static inline int OFFSET(void *ptr);
static void ReleaseDictIterator(Tcl_Obj *objPtr);
-/* 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);
static Tcl_NRPostProc CopyCallback;
static Tcl_NRPostProc ExprObjCallback;
@@ -845,10 +826,7 @@ TclCreateExecEnv(
* [sizeof(Tcl_Obj*)] */
{
ExecEnv *eePtr = ckalloc(sizeof(ExecEnv));
- ExecStack *esPtr = ckalloc(sizeof(ExecStack)
- + (size_t) (size-1) * sizeof(Tcl_Obj *));
- eePtr->execStackPtr = esPtr;
TclNewBooleanObj(eePtr->constants[0], 0);
Tcl_IncrRefCount(eePtr->constants[0]);
TclNewBooleanObj(eePtr->constants[1], 1);
@@ -858,12 +836,6 @@ TclCreateExecEnv(
eePtr->corPtr = NULL;
eePtr->rewind = 0;
- esPtr->prevPtr = NULL;
- esPtr->nextPtr = NULL;
- esPtr->markerPtr = NULL;
- esPtr->endPtr = &esPtr->stackWords[size-1];
- esPtr->tosPtr = &esPtr->stackWords[-1];
-
Tcl_MutexLock(&execMutex);
if (!execInitialized) {
TclInitAuxDataTypeTable();
@@ -892,42 +864,14 @@ 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(esPtr);
-}
-
void
TclDeleteExecEnv(
ExecEnv *eePtr) /* Execution environment to free. */
{
- 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]);
if (eePtr->callbackPtr) {
@@ -967,339 +911,6 @@ TclFinalizeExecution(void)
}
/*
- * Auxiliary code to insure that GrowEvaluationStack always returns correctly
- * aligned memory.
- *
- * WALLOCALIGN represents the alignment reqs in words, just as TCL_ALLOCALIGN
- * represents the reqs in bytes. This assumes that TCL_ALLOCALIGN is a
- * multiple of the wordsize 'sizeof(Tcl_Obj *)'.
- */
-
-#define WALLOCALIGN \
- (TCL_ALLOCALIGN/sizeof(Tcl_Obj *))
-
-/*
- * OFFSET computes how many words have to be skipped until the next aligned
- * word. Note that we are only interested in the low order bits of ptr, so
- * that any possible information loss in PTR2INT is of no consequence.
- */
-
-static inline int
-OFFSET(
- void *ptr)
-{
- int mask = TCL_ALLOCALIGN-1;
- int base = PTR2INT(ptr) & mask;
- return (TCL_ALLOCALIGN - base)/sizeof(Tcl_Obj *);
-}
-
-/*
- * Given a marker, compute where the following aligned memory starts.
- */
-
-#define MEMSTART(markerPtr) \
- ((markerPtr) + OFFSET(markerPtr))
-
-/*
- *----------------------------------------------------------------------
- *
- * GrowEvaluationStack --
- *
- * 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:
- * Returns a pointer to the first usable word in the (possibly) grown
- * stack.
- *
- * Side effects:
- * The size of the evaluation stack may be grown, a marker is set
- *
- *----------------------------------------------------------------------
- */
-
-static Tcl_Obj **
-GrowEvaluationStack(
- 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. */
-{
- ExecStack *esPtr = eePtr->execStackPtr, *oldPtr = NULL;
- int newBytes, newElems, currElems;
- int needed = growth - (esPtr->endPtr - esPtr->tosPtr);
- Tcl_Obj **markerPtr = esPtr->markerPtr, **memStart;
- int moveWords = 0;
-
- if (move) {
- if (!markerPtr) {
- Tcl_Panic("STACK: Reallocating with no previous alloc");
- }
- if (needed <= 0) {
- return MEMSTART(markerPtr);
- }
- } else {
- Tcl_Obj **tmpMarkerPtr = esPtr->tosPtr + 1;
- int offset = OFFSET(tmpMarkerPtr);
-
- if (needed + offset < 0) {
- /*
- * Put a marker pointing to the previous marker in this stack, and
- * store it in esPtr as the current marker. Return a pointer to
- * the start of aligned memory.
- */
-
- esPtr->markerPtr = tmpMarkerPtr;
- memStart = tmpMarkerPtr + offset;
- esPtr->tosPtr = memStart - 1;
- *esPtr->markerPtr = (Tcl_Obj *) markerPtr;
- return memStart;
- }
- }
-
- /*
- * Reset move to hold the number of words to be moved to new stack (if
- * any) and growth to hold the complete stack requirements: add one for
- * the marker, (WALLOCALIGN-1) for the maximal possible offset.
- */
-
- if (move) {
- moveWords = esPtr->tosPtr - MEMSTART(markerPtr) + 1;
- }
- needed = growth + moveWords + WALLOCALIGN;
-
- /*
- * 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;
- }
- 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) {
- newElems *= 2;
- }
- newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *);
-
- oldPtr = esPtr;
- esPtr = ckalloc(newBytes);
-
- oldPtr->nextPtr = esPtr;
- esPtr->prevPtr = oldPtr;
- esPtr->nextPtr = NULL;
- esPtr->endPtr = &esPtr->stackWords[newElems-1];
-
- newStackReady:
- eePtr->execStackPtr = esPtr;
-
- /*
- * Store a NULL marker at the beginning of the stack, to indicate that
- * this is the first marker in this stack and that rewinding to here
- * should actually be a return to the previous stack.
- */
-
- esPtr->stackWords[0] = NULL;
- esPtr->markerPtr = &esPtr->stackWords[0];
- memStart = MEMSTART(esPtr->markerPtr);
- esPtr->tosPtr = memStart - 1;
-
- if (move) {
- memcpy(memStart, MEMSTART(markerPtr), moveWords*sizeof(Tcl_Obj *));
- esPtr->tosPtr += moveWords;
- oldPtr->markerPtr = (Tcl_Obj **) *markerPtr;
- oldPtr->tosPtr = markerPtr-1;
- }
-
- /*
- * Free the old stack if it is now unused.
- */
-
- if (!oldPtr->markerPtr) {
- DeleteExecStack(oldPtr);
- }
-
- return memStart;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * TclStackAlloc, TclStackRealloc, TclStackFree --
- *
- * Allocate memory from the execution stack; it has to be returned later
- * with a call to TclStackFree.
- *
- * Results:
- * A pointer to the first byte allocated, or panics if the allocation did
- * not succeed.
- *
- * Side effects:
- * The execution stack may be grown.
- *
- *--------------------------------------------------------------
- */
-
-static Tcl_Obj **
-StackAllocWords(
- Tcl_Interp *interp,
- int numWords)
-{
- /*
- * Note that GrowEvaluationStack sets a marker in the stack. This marker
- * is read when rewinding, e.g., by TclStackFree.
- */
-
- Interp *iPtr = (Interp *) interp;
- ExecEnv *eePtr = iPtr->execEnvPtr;
- Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 0);
-
- eePtr->execStackPtr->tosPtr += numWords;
- return resPtr;
-}
-
-static Tcl_Obj **
-StackReallocWords(
- Tcl_Interp *interp,
- int numWords)
-{
- Interp *iPtr = (Interp *) interp;
- ExecEnv *eePtr = iPtr->execEnvPtr;
- Tcl_Obj **resPtr = GrowEvaluationStack(eePtr, numWords, 1);
-
- eePtr->execStackPtr->tosPtr += numWords;
- return resPtr;
-}
-
-void
-TclStackFree(
- Tcl_Interp *interp,
- void *freePtr)
-{
- Interp *iPtr = (Interp *) interp;
- ExecEnv *eePtr;
- ExecStack *esPtr;
- Tcl_Obj **markerPtr, *marker;
-
- if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
- Tcl_Free((char *) freePtr);
- return;
- }
-
- /*
- * Rewind the stack to the previous marker position. The current marker,
- * as set in the last call to GrowEvaluationStack, contains a pointer to
- * the previous marker.
- */
-
- eePtr = iPtr->execEnvPtr;
- esPtr = eePtr->execStackPtr;
- markerPtr = esPtr->markerPtr;
- marker = *markerPtr;
-
- if ((freePtr != NULL) && (MEMSTART(markerPtr) != (Tcl_Obj **)freePtr)) {
- Tcl_Panic("TclStackFree: incorrect freePtr (%p != %p). Call out of sequence?",
- freePtr, MEMSTART(markerPtr));
- }
-
- esPtr->tosPtr = markerPtr - 1;
- esPtr->markerPtr = (Tcl_Obj **) marker;
- if (marker) {
- return;
- }
-
- /*
- * Return to previous active stack. Note that repeated expansions or
- * reallocs could have generated several unused intervening stacks: free
- * them too.
- */
-
- while (esPtr->nextPtr) {
- esPtr = esPtr->nextPtr;
- }
- esPtr->tosPtr = &esPtr->stackWords[-1];
- while (esPtr->prevPtr) {
- ExecStack *tmpPtr = esPtr->prevPtr;
- if (tmpPtr->tosPtr == &tmpPtr->stackWords[-1]) {
- DeleteExecStack(tmpPtr);
- } else {
- break;
- }
- }
- if (esPtr->prevPtr) {
- eePtr->execStackPtr = esPtr->prevPtr;
- } else {
- eePtr->execStackPtr = esPtr;
- }
-}
-
-void *
-TclStackAlloc(
- Tcl_Interp *interp,
- int numBytes)
-{
- Interp *iPtr = (Interp *) interp;
- int numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
-
- if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
- return (void *) Tcl_Alloc(numBytes);
- }
-
- return (void *) StackAllocWords(interp, numWords);
-}
-
-void *
-TclStackRealloc(
- Tcl_Interp *interp,
- void *ptr,
- int numBytes)
-{
- Interp *iPtr = (Interp *) interp;
- ExecEnv *eePtr;
- ExecStack *esPtr;
- Tcl_Obj **markerPtr;
- int numWords;
-
- if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
- return (void *) Tcl_Realloc((char *) ptr, numBytes);
- }
-
- eePtr = iPtr->execEnvPtr;
- esPtr = eePtr->execStackPtr;
- markerPtr = esPtr->markerPtr;
-
- if (MEMSTART(markerPtr) != (Tcl_Obj **)ptr) {
- Tcl_Panic("TclStackRealloc: incorrect ptr. Call out of sequence?");
- }
-
- numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
- return (void *) StackReallocWords(interp, numWords);
-}
-
-/*
*--------------------------------------------------------------
*
* Tcl_ExprObj --
@@ -1697,7 +1308,7 @@ TclCompileObj(
int redo = 0;
if (invoker) {
- CmdFrame *ctxPtr = TclStackAlloc(interp,sizeof(CmdFrame));
+ CmdFrame *ctxPtr = ckalloc(sizeof(CmdFrame));
*ctxPtr = *invoker;
if (invoker->type == TCL_LOCATION_BC) {
@@ -1736,7 +1347,7 @@ TclCompileObj(
&& (ctxPtr->type == TCL_LOCATION_SOURCE));
}
- TclStackFree(interp, ctxPtr);
+ ckfree(ctxPtr);
}
if (redo) {
@@ -1921,9 +1532,8 @@ TclIncrObj(
*----------------------------------------------------------------------
*/
#define bcFramePtr (&TD->cmdFrame)
-#define initCatchTop ((ptrdiff_t *) (&TD->stack[-1]))
-#define initTosPtr ((Tcl_Obj **) (initCatchTop+codePtr->maxExceptDepth))
-#define esPtr (iPtr->execEnvPtr->execStackPtr)
+#define catchStack (TD->stack)
+#define initTosPtr ((Tcl_Obj **) &TD->stack[codePtr->maxExceptDepth - 1])
int
TclNRExecuteByteCode(
@@ -1932,10 +1542,8 @@ TclNRExecuteByteCode(
{
Interp *iPtr = (Interp *) interp;
TEBCdata *TD;
- int size = sizeof(TEBCdata) -1 +
- + (codePtr->maxStackDepth + codePtr->maxExceptDepth)
- *(sizeof(void *));
- int numWords = (size + sizeof(Tcl_Obj *) - 1)/sizeof(Tcl_Obj *);
+ unsigned int size = sizeof(TEBCdata) + sizeof(void *) *
+ (codePtr->maxStackDepth + codePtr->maxExceptDepth - 1);
if (iPtr->execEnvPtr->rewind) {
return TCL_ERROR;
@@ -1955,15 +1563,16 @@ TclNRExecuteByteCode(
* execution stack is large enough to execute this ByteCode.
*/
- TD = (TEBCdata *) GrowEvaluationStack(iPtr->execEnvPtr, numWords, 0);
- esPtr->tosPtr = initTosPtr;
+ TD = ckalloc(size);
+ TD->tosPtr = initTosPtr;
TD->codePtr = codePtr;
TD->pc = codePtr->codeStart;
- TD->catchTop = initCatchTop;
+ TD->catchDepth = -1;
TD->cleanup = 0;
TD->auxObjList = NULL;
TD->checkInterp = 0;
+ TD->capacity = codePtr->maxStackDepth;
/*
* TIP #280: Initialize the frame. Do not push it yet: it will be pushed
@@ -2048,11 +1657,11 @@ TEBCresume(
TEBCdata *TD = data[0];
#define auxObjList (TD->auxObjList)
-#define catchTop (TD->catchTop)
+#define catchDepth (TD->catchDepth)
#define codePtr (TD->codePtr)
#define checkInterp (TD->checkInterp)
/* Indicates when a check of interp readyness
- * is necessary. Set by CACHE_STACK_INFO() */
+ * is necessary. Set by checkInterp = 1 */
/*
* Globals: variables that store state, must remain valid at all times.
@@ -2113,7 +1722,7 @@ TEBCresume(
codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
}
- CACHE_STACK_INFO();
+ checkInterp = 1;
if (result == TCL_OK) {
#ifndef TCL_COMPILE_DEBUG
if (*pc == INST_POP) {
@@ -2253,29 +1862,28 @@ TEBCresume(
*/
if ((instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) {
- DECACHE_STACK_INFO();
if (TclAsyncReady(iPtr)) {
result = Tcl_AsyncInvoke(interp, result);
if (result == TCL_ERROR) {
- CACHE_STACK_INFO();
+ checkInterp = 1;
goto gotError;
}
}
if (TclCanceled(iPtr)) {
if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
- CACHE_STACK_INFO();
+ checkInterp = 1;
goto gotError;
}
}
if (TclLimitReady(iPtr->limit)) {
if (Tcl_LimitCheck(interp) == TCL_ERROR) {
- CACHE_STACK_INFO();
+ checkInterp = 1;
goto gotError;
}
}
- CACHE_STACK_INFO();
+ checkInterp = 1;
}
TCL_DTRACE_INST_NEXT();
@@ -2643,7 +2251,7 @@ TEBCresume(
case INST_EXPAND_STKTOP: {
int i;
- ptrdiff_t moved;
+ unsigned int reqWords;
/*
* Make sure that the element at stackTop is a list; if not, just
@@ -2657,7 +2265,6 @@ TEBCresume(
Tcl_GetObjResult(interp));
goto gotError;
}
- (void) POP_OBJECT();
/*
* Make sure there is enough room in the stack to expand this list
@@ -2666,24 +2273,26 @@ TEBCresume(
* stack depth, as seen by the compiler.
*/
- length = objc + (codePtr->maxStackDepth - TclGetInt4AtPtr(pc+1));
- DECACHE_STACK_INFO();
- moved = GrowEvaluationStack(iPtr->execEnvPtr, length, 1)
- - (Tcl_Obj **) TD;
- if (moved) {
- /*
- * Change the global data to point to the new stack: move the
- * TEBCdataPtr TD, recompute the position of every other
- * stack-allocated parameter, update the stack pointers.
- */
-
- esPtr = iPtr->execEnvPtr->execStackPtr;
- TD = (TEBCdata *) (((Tcl_Obj **)TD) + moved);
+ reqWords =
+ /* how many were needed originally */
+ codePtr->maxStackDepth
+ /* plus how many we already consumed in previous expansions */
+ + (CURR_DEPTH - TclGetInt4AtPtr(pc+1))
+ /* plus how many are needed for this expansion */
+ + objc - 1;
- catchTop += moved;
- tosPtr += moved;
+ (void) POP_OBJECT();
+ if (reqWords > TD->capacity) {
+ ptrdiff_t depth;
+ unsigned int size = sizeof(TEBCdata) + sizeof(void *) *
+ + (reqWords + codePtr->maxExceptDepth - 1);
+
+ depth = tosPtr - initTosPtr;
+ TD = ckrealloc(TD, size);
+ tosPtr = initTosPtr + depth;
+ TD->capacity = reqWords;
}
-
+
/*
* Expand the list at stacktop onto the stack; free the list. Knowing
* that it has a freeIntRepProc we use Tcl_DecrRefCount().
@@ -2702,9 +2311,8 @@ TEBCresume(
bcFramePtr->data.tebc.pc = (char *) pc;
iPtr->cmdFramePtr = bcFramePtr;
- DECACHE_STACK_INFO();
newCodePtr = CompileExprObj(interp, OBJ_AT_TOS);
- CACHE_STACK_INFO();
+ checkInterp = 1;
cleanup = 1;
pc++;
TEBC_YIELD();
@@ -2790,8 +2398,6 @@ TEBCresume(
codePtr, bcFramePtr, pc - codePtr->codeStart);
}
- DECACHE_STACK_INFO();
-
pc += pcAdjustment;
TEBC_YIELD();
return TclNREvalObjv(interp, objc, objv,
@@ -3016,10 +2622,9 @@ TEBCresume(
* TclPtrGetVar to process fully.
*/
- DECACHE_STACK_INFO();
objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr,
part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd);
- CACHE_STACK_INFO();
+ checkInterp = 1;
if (!objResultPtr) {
TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
goto gotError;
@@ -3263,10 +2868,9 @@ TEBCresume(
part1Ptr = part2Ptr = NULL;
doCallPtrSetVar:
- DECACHE_STACK_INFO();
objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr,
part1Ptr, part2Ptr, valuePtr, storeFlags, opnd);
- CACHE_STACK_INFO();
+ checkInterp = 1;
if (!objResultPtr) {
TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
goto gotError;
@@ -3527,10 +3131,9 @@ TEBCresume(
}
Tcl_DecrRefCount(incrPtr);
} else {
- DECACHE_STACK_INFO();
objResultPtr = TclPtrIncrObjVar(interp, varPtr, arrayPtr,
part1Ptr, part2Ptr, incrPtr, TCL_LEAVE_ERR_MSG, opnd);
- CACHE_STACK_INFO();
+ checkInterp = 1;
Tcl_DecrRefCount(incrPtr);
if (objResultPtr == NULL) {
TRACE_APPEND(("ERROR: %.30s\n",
@@ -3562,10 +3165,9 @@ TEBCresume(
}
TRACE(("%u => ", opnd));
if (ReadTraced(varPtr)) {
- DECACHE_STACK_INFO();
TclObjCallVarTraces(iPtr, NULL, varPtr, NULL, NULL,
TCL_TRACE_READS, 0, opnd);
- CACHE_STACK_INFO();
+ checkInterp = 1;
if (TclIsVarUndefined(varPtr)) {
TclCleanupVar(varPtr, NULL);
varPtr = NULL;
@@ -3598,10 +3200,9 @@ TEBCresume(
0, 1, arrayPtr, opnd);
if (varPtr) {
if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) {
- DECACHE_STACK_INFO();
TclObjCallVarTraces(iPtr, arrayPtr, varPtr, NULL, part2Ptr,
TCL_TRACE_READS, 0, opnd);
- CACHE_STACK_INFO();
+ checkInterp = 1;
}
if (TclIsVarUndefined(varPtr)) {
TclCleanupVar(varPtr, arrayPtr);
@@ -3631,10 +3232,9 @@ TEBCresume(
/*createPart1*/0, /*createPart2*/1, &arrayPtr);
if (varPtr) {
if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) {
- DECACHE_STACK_INFO();
TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,part2Ptr,
TCL_TRACE_READS, 0, -1);
- CACHE_STACK_INFO();
+ checkInterp = 1;
}
if (TclIsVarUndefined(varPtr)) {
TclCleanupVar(varPtr, arrayPtr);
@@ -3678,12 +3278,11 @@ TEBCresume(
}
slowUnsetScalar:
- DECACHE_STACK_INFO();
if (TclPtrUnsetVar(interp, varPtr, NULL, NULL, NULL, flags,
opnd) != TCL_OK && flags) {
goto errorInUnset;
}
- CACHE_STACK_INFO();
+ checkInterp = 1;
NEXT_INST_F(6, 0, 0);
case INST_UNSET_ARRAY:
@@ -3720,7 +3319,6 @@ TEBCresume(
}
}
slowUnsetArray:
- DECACHE_STACK_INFO();
varPtr = TclLookupArrayElement(interp, NULL, part2Ptr, flags, "unset",
0, 0, arrayPtr, opnd);
if (!varPtr) {
@@ -3731,7 +3329,7 @@ TEBCresume(
flags, opnd) != TCL_OK && (flags & TCL_LEAVE_ERR_MSG)) {
goto errorInUnset;
}
- CACHE_STACK_INFO();
+ checkInterp = 1;
NEXT_INST_F(6, 1, 0);
case INST_UNSET_ARRAY_STK:
@@ -3751,16 +3349,15 @@ TEBCresume(
TRACE(("%s \"%.30s\"\n", (flags?"normal":"noerr"), O2S(part1Ptr)));
doUnsetStk:
- DECACHE_STACK_INFO();
if (TclObjUnsetVar2(interp, part1Ptr, part2Ptr, flags) != TCL_OK
&& (flags & TCL_LEAVE_ERR_MSG)) {
goto errorInUnset;
}
- CACHE_STACK_INFO();
+ checkInterp = 1;
NEXT_INST_V(2, cleanup, 0);
errorInUnset:
- CACHE_STACK_INFO();
+ checkInterp = 1;
TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
goto gotError;
@@ -3781,9 +3378,8 @@ TEBCresume(
}
varPtr->value.objPtr = NULL;
} else {
- DECACHE_STACK_INFO();
TclPtrUnsetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd);
- CACHE_STACK_INFO();
+ checkInterp = 1;
}
NEXT_INST_F(5, 0, 0);
}
@@ -4024,18 +3620,16 @@ TEBCresume(
if (TclGetBooleanFromObj(NULL, valuePtr, &i1) != TCL_OK) {
TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
- DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
- CACHE_STACK_INFO();
+ checkInterp = 1;
goto gotError;
}
if (TclGetBooleanFromObj(NULL, value2Ptr, &i2) != TCL_OK) {
TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr),
(value2Ptr->typePtr? value2Ptr->typePtr->name : "null")));
- DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, value2Ptr);
- CACHE_STACK_INFO();
+ checkInterp = 1;
goto gotError;
}
@@ -4812,9 +4406,8 @@ TEBCresume(
TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n", O2S(valuePtr),
O2S(value2Ptr), (valuePtr->typePtr?
valuePtr->typePtr->name : "null")));
- DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
- CACHE_STACK_INFO();
+ checkInterp = 1;
goto gotError;
}
@@ -4823,9 +4416,8 @@ TEBCresume(
TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n", O2S(valuePtr),
O2S(value2Ptr), (value2Ptr->typePtr?
value2Ptr->typePtr->name : "null")));
- DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, value2Ptr);
- CACHE_STACK_INFO();
+ checkInterp = 1;
goto gotError;
}
@@ -4883,11 +4475,10 @@ TEBCresume(
Tcl_SetResult(interp, "negative shift argument",
TCL_STATIC);
#if 0
- DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"domain error: argument not in valid range",
NULL);
- CACHE_STACK_INFO();
+ checkInterp = 1;
#endif
goto gotError;
} else if (l1 == 0) {
@@ -4931,11 +4522,10 @@ TEBCresume(
Tcl_SetResult(interp, "negative shift argument",
TCL_STATIC);
#if 0
- DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"domain error: argument not in valid range",
NULL);
- CACHE_STACK_INFO();
+ checkInterp = 1;
#endif
goto gotError;
} else if (l1 == 0) {
@@ -4955,10 +4545,9 @@ TEBCresume(
"integer value too large to represent",
TCL_STATIC);
#if 0
- DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
"integer value too large to represent", NULL);
- CACHE_STACK_INFO();
+ checkInterp = 1;
#endif
goto gotError;
} else {
@@ -5041,9 +4630,8 @@ TEBCresume(
TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
O2S(value2Ptr), O2S(valuePtr),
(valuePtr->typePtr? valuePtr->typePtr->name: "null")));
- DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
- CACHE_STACK_INFO();
+ checkInterp = 1;
goto gotError;
}
@@ -5062,9 +4650,8 @@ TEBCresume(
TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
O2S(value2Ptr), O2S(valuePtr),
(value2Ptr->typePtr? value2Ptr->typePtr->name: "null")));
- DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, value2Ptr);
- CACHE_STACK_INFO();
+ checkInterp = 1;
goto gotError;
}
@@ -5211,9 +4798,8 @@ TEBCresume(
if (TclGetBooleanFromObj(NULL, valuePtr, &b) != TCL_OK) {
TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", O2S(valuePtr),
(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
- DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
- CACHE_STACK_INFO();
+ checkInterp = 1;
goto gotError;
}
/* TODO: Consider peephole opt. */
@@ -5231,9 +4817,8 @@ TEBCresume(
TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
- DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
- CACHE_STACK_INFO();
+ checkInterp = 1;
goto gotError;
}
if (type1 == TCL_NUMBER_LONG) {
@@ -5258,9 +4843,8 @@ TEBCresume(
|| IsErroringNaNType(type1)) {
TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
- DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
- CACHE_STACK_INFO();
+ checkInterp = 1;
goto gotError;
}
switch (type1) {
@@ -5304,9 +4888,8 @@ TEBCresume(
TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
- DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
- CACHE_STACK_INFO();
+ checkInterp = 1;
goto gotError;
}
@@ -5322,9 +4905,8 @@ TEBCresume(
TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
- DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
- CACHE_STACK_INFO();
+ checkInterp = 1;
} else {
/*
* Numeric conversion of NaN -> error.
@@ -5332,9 +4914,8 @@ TEBCresume(
TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
O2S(objResultPtr)));
- DECACHE_STACK_INFO();
TclExprFloatError(interp, *((const double *) ptr1));
- CACHE_STACK_INFO();
+ checkInterp = 1;
}
goto gotError;
}
@@ -5379,9 +4960,8 @@ TEBCresume(
case INST_BREAK:
/*
- DECACHE_STACK_INFO();
Tcl_ResetResult(interp);
- CACHE_STACK_INFO();
+ checkInterp = 1;
*/
result = TCL_BREAK;
cleanup = 0;
@@ -5389,9 +4969,8 @@ TEBCresume(
case INST_CONTINUE:
/*
- DECACHE_STACK_INFO();
Tcl_ResetResult(interp);
- CACHE_STACK_INFO();
+ checkInterp = 1;
*/
result = TCL_CONTINUE;
cleanup = 0;
@@ -5524,17 +5103,16 @@ TEBCresume(
Tcl_IncrRefCount(valuePtr);
}
} else {
- DECACHE_STACK_INFO();
if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
- CACHE_STACK_INFO();
+ checkInterp = 1;
TRACE_WITH_OBJ((
"%u => ERROR init. index temp %d: ",
opnd,varIndex), Tcl_GetObjResult(interp));
TclDecrRefCount(listPtr);
goto gotError;
}
- CACHE_STACK_INFO();
+ checkInterp = 1;
}
valIndex++;
}
@@ -5566,19 +5144,18 @@ TEBCresume(
* stack.
*/
- *(++catchTop) = CURR_DEPTH;
- TRACE(("%u => catchTop=%d, stackTop=%d\n",
- TclGetUInt4AtPtr(pc+1), (int) (catchTop - initCatchTop - 1),
+ catchStack[++catchDepth] = INT2PTR(CURR_DEPTH);
+ TRACE(("%u => catchDepth=%d, stackTop=%d\n",
+ TclGetUInt4AtPtr(pc+1), (int) (catchDepth),
(int) CURR_DEPTH));
NEXT_INST_F(5, 0, 0);
case INST_END_CATCH:
- catchTop--;
- DECACHE_STACK_INFO();
+ catchDepth--;
Tcl_ResetResult(interp);
- CACHE_STACK_INFO();
+ checkInterp = 1;
result = TCL_OK;
- TRACE(("=> catchTop=%d\n", (int) (catchTop - initCatchTop - 1)));
+ TRACE(("=> catchDepth=%d\n", (int) (catchDepth)));
NEXT_INST_F(1, 0, 0);
case INST_PUSH_RESULT:
@@ -5600,9 +5177,8 @@ TEBCresume(
NEXT_INST_F(1, 0, 1);
case INST_PUSH_RETURN_OPTIONS:
- DECACHE_STACK_INFO();
objResultPtr = Tcl_GetReturnOptions(interp, result);
- CACHE_STACK_INFO();
+ checkInterp = 1;
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(1, 0, 1);
@@ -5654,13 +5230,12 @@ TEBCresume(
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
NEXT_INST_V(5, opnd+1, 1);
}
- DECACHE_STACK_INFO();
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "key \"", TclGetString(OBJ_AT_TOS),
"\" not known in dictionary", NULL);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
TclGetString(OBJ_AT_TOS), NULL);
- CACHE_STACK_INFO();
+ checkInterp = 1;
TRACE_WITH_OBJ(("%u => ERROR ", opnd), Tcl_GetObjResult(interp));
} else {
TRACE_WITH_OBJ((
@@ -5683,9 +5258,8 @@ TEBCresume(
if (TclIsVarDirectReadable(varPtr)) {
dictPtr = varPtr->value.objPtr;
} else {
- DECACHE_STACK_INFO();
dictPtr = TclPtrGetVar(interp, varPtr, NULL,NULL,NULL, 0, opnd2);
- CACHE_STACK_INFO();
+ checkInterp = 1;
}
if (dictPtr == NULL) {
TclNewObj(dictPtr);
@@ -5757,10 +5331,9 @@ TEBCresume(
objResultPtr = dictPtr;
} else {
Tcl_IncrRefCount(dictPtr);
- DECACHE_STACK_INFO();
objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
dictPtr, TCL_LEAVE_ERR_MSG, opnd2);
- CACHE_STACK_INFO();
+ checkInterp = 1;
TclDecrRefCount(dictPtr);
if (objResultPtr == NULL) {
TRACE_APPEND(("ERROR: %.30s\n",
@@ -5787,9 +5360,8 @@ TEBCresume(
if (TclIsVarDirectReadable(varPtr)) {
dictPtr = varPtr->value.objPtr;
} else {
- DECACHE_STACK_INFO();
dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd);
- CACHE_STACK_INFO();
+ checkInterp = 1;
}
if (dictPtr == NULL) {
TclNewObj(dictPtr);
@@ -5893,10 +5465,9 @@ TEBCresume(
objResultPtr = dictPtr;
} else {
Tcl_IncrRefCount(dictPtr);
- DECACHE_STACK_INFO();
objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
dictPtr, TCL_LEAVE_ERR_MSG, opnd);
- CACHE_STACK_INFO();
+ checkInterp = 1;
TclDecrRefCount(dictPtr);
if (objResultPtr == NULL) {
TRACE_APPEND(("ERROR: %.30s\n",
@@ -5998,10 +5569,9 @@ TEBCresume(
if (TclIsVarDirectReadable(varPtr)) {
dictPtr = varPtr->value.objPtr;
} else {
- DECACHE_STACK_INFO();
dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL,
TCL_LEAVE_ERR_MSG, opnd);
- CACHE_STACK_INFO();
+ checkInterp = 1;
if (dictPtr == NULL) {
goto gotError;
}
@@ -6022,7 +5592,6 @@ TEBCresume(
while (TclIsVarLink(varPtr)) {
varPtr = varPtr->value.linkPtr;
}
- DECACHE_STACK_INFO();
if (valuePtr == NULL) {
TclObjUnsetVar2(interp,
localName(iPtr->varFramePtr, duiPtr->varIndices[i]),
@@ -6030,10 +5599,10 @@ TEBCresume(
} else if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
valuePtr, TCL_LEAVE_ERR_MSG,
duiPtr->varIndices[i]) == NULL) {
- CACHE_STACK_INFO();
+ checkInterp = 1;
goto gotError;
}
- CACHE_STACK_INFO();
+ checkInterp = 1;
}
NEXT_INST_F(9, 0, 0);
@@ -6049,9 +5618,8 @@ TEBCresume(
if (TclIsVarDirectReadable(varPtr)) {
dictPtr = varPtr->value.objPtr;
} else {
- DECACHE_STACK_INFO();
dictPtr = TclPtrGetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd);
- CACHE_STACK_INFO();
+ checkInterp = 1;
}
if (dictPtr == NULL) {
NEXT_INST_F(9, 1, 0);
@@ -6077,10 +5645,9 @@ TEBCresume(
if (TclIsVarDirectReadable(var2Ptr)) {
valuePtr = var2Ptr->value.objPtr;
} else {
- DECACHE_STACK_INFO();
valuePtr = TclPtrGetVar(interp, var2Ptr, NULL, NULL, NULL, 0,
duiPtr->varIndices[i]);
- CACHE_STACK_INFO();
+ checkInterp = 1;
}
if (valuePtr == NULL) {
Tcl_DictObjRemove(interp, dictPtr, keyPtrPtr[i]);
@@ -6096,10 +5663,9 @@ TEBCresume(
TclDecrRefCount(varPtr->value.objPtr);
varPtr->value.objPtr = dictPtr;
} else {
- DECACHE_STACK_INFO();
objResultPtr = TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
dictPtr, TCL_LEAVE_ERR_MSG, opnd);
- CACHE_STACK_INFO();
+ checkInterp = 1;
if (objResultPtr == NULL) {
if (allocdict) {
TclDecrRefCount(dictPtr);
@@ -6215,10 +5781,9 @@ TEBCresume(
*/
divideByZero:
- DECACHE_STACK_INFO();
Tcl_SetResult(interp, "divide by zero", TCL_STATIC);
Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
- CACHE_STACK_INFO();
+ checkInterp = 1;
goto gotError;
/*
@@ -6227,12 +5792,11 @@ TEBCresume(
*/
exponOfZero:
- DECACHE_STACK_INFO();
Tcl_SetResult(interp, "exponentiation of zero by negative power",
TCL_STATIC);
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"exponentiation of zero by negative power", NULL);
- CACHE_STACK_INFO();
+ checkInterp = 1;
/*
* Almost all error paths feed through here rather than assigning to
@@ -6258,9 +5822,8 @@ TEBCresume(
const unsigned char *pcBeg;
bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg);
- DECACHE_STACK_INFO();
TclLogCommandInfo(interp, codePtr->source, bytes, bytes ? length : 0, pcBeg, tosPtr);
- CACHE_STACK_INFO();
+ checkInterp = 1;
}
iPtr->flags &= ~ERR_ALREADY_LOGGED;
@@ -6270,8 +5833,8 @@ TEBCresume(
*/
while (auxObjList) {
- if ((catchTop != initCatchTop) && (*catchTop >
- (ptrdiff_t) auxObjList->internalRep.twoPtrValue.ptr1)) {
+ if ((catchDepth >=0) && (PTR2INT(catchStack[catchDepth]) >
+ PTR2INT(auxObjList->internalRep.twoPtrValue.ptr1))) {
break;
}
POP_TAUX_OBJ();
@@ -6311,7 +5874,7 @@ TEBCresume(
#endif
goto abnormalReturn;
}
- if (catchTop == initCatchTop) {
+ if (catchDepth == -1) {
#ifdef TCL_COMPILE_DEBUG
if (traceInstructions) {
fprintf(stdout, " ... no enclosing catch, returning %s\n",
@@ -6346,16 +5909,16 @@ TEBCresume(
*/
processCatch:
- while (CURR_DEPTH > *catchTop) {
+ while (CURR_DEPTH > PTR2INT(catchStack[catchDepth])) {
valuePtr = POP_OBJECT();
TclDecrRefCount(valuePtr);
}
#ifdef TCL_COMPILE_DEBUG
if (traceInstructions) {
- fprintf(stdout, " ... found catch at %d, catchTop=%d, "
+ fprintf(stdout, " ... found catch at %d, catchDepth=%d, "
"unwound to %ld, new pc %u\n",
- rangePtr->codeOffset, (int) (catchTop - initCatchTop - 1),
- (long) *catchTop, (unsigned) rangePtr->catchOffset);
+ rangePtr->codeOffset, (int) catchDepth,
+ PTR2INT(catchStack[catchDepth]), (unsigned) rangePtr->catchOffset);
}
#endif
pc = (codePtr->codeStart + rangePtr->catchOffset);
@@ -6404,7 +5967,7 @@ TEBCresume(
if (--codePtr->refCount <= 0) {
TclCleanupByteCode(codePtr);
}
- TclStackFree(interp, TD); /* free my stack */
+ ckfree(TD); /* free my stack */
return result;
}
@@ -6412,10 +5975,9 @@ TEBCresume(
#undef codePtr
#undef iPtr
#undef bcFramePtr
-#undef initCatchTop
#undef initTosPtr
#undef auxObjList
-#undef catchTop
+#undef catchDepth
#undef TCONST
/*
generated by cgit v0.12 at 2024-10-28 20:15:01 (GMT)