summaryrefslogtreecommitdiffstats
path: root/generic/tclExecute.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r--generic/tclExecute.c179
1 files changed, 122 insertions, 57 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 6221c19..fae2aa6 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -19,6 +19,7 @@
#include "tclCompile.h"
#include "tclOOInt.h"
#include "tclTomMath.h"
+#include "tclArithSeries.h"
#include <math.h>
#include <assert.h>
@@ -111,11 +112,11 @@ size_t tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
typedef struct {
ByteCode *codePtr; /* Constant until the BC returns */
/* -----------------------------------------*/
- ptrdiff_t *catchTop; /* These fields are used on return TO this */
+ Tcl_Obj **catchTop; /* These fields are used on return TO this */
Tcl_Obj *auxObjList; /* this level: they record the state when a */
CmdFrame cmdFrame; /* new codePtr was received for NR */
/* execution. */
- void *stack[1]; /* Start of the actual combined catch and obj
+ Tcl_Obj *stack[1]; /* Start of the actual combined catch and obj
* stacks; the struct will be expanded as
* necessary */
} TEBCdata;
@@ -366,7 +367,7 @@ VarHashCreateVar(
#define OBJ_AT_DEPTH(n) *(tosPtr-(n))
-#define CURR_DEPTH ((ptrdiff_t) (tosPtr - initTosPtr))
+#define CURR_DEPTH ((size_t)(tosPtr - initTosPtr))
#define STACK_BASE(esPtr) ((esPtr)->stackWords - 1)
@@ -379,9 +380,9 @@ VarHashCreateVar(
#ifdef TCL_COMPILE_DEBUG
# define TRACE(a) \
while (traceInstructions) { \
- fprintf(stdout, "%2" TCL_Z_MODIFIER "d: %2d (%" TCL_Z_MODIFIER "u) %s ", iPtr->numLevels, \
- (int) CURR_DEPTH, \
- (size_t) (pc - codePtr->codeStart), \
+ fprintf(stdout, "%2" TCL_Z_MODIFIER "u: %2" TCL_Z_MODIFIER "u (%" TCL_Z_MODIFIER "u) %s ", iPtr->numLevels, \
+ CURR_DEPTH, \
+ (size_t)(pc - codePtr->codeStart), \
GetOpcodeName(pc)); \
printf a; \
break; \
@@ -395,9 +396,9 @@ VarHashCreateVar(
TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
# define TRACE_WITH_OBJ(a, objPtr) \
while (traceInstructions) { \
- fprintf(stdout, "%2" TCL_Z_MODIFIER "d: %2d (%" TCL_Z_MODIFIER "u) %s ", iPtr->numLevels, \
- (int) CURR_DEPTH, \
- (size_t) (pc - codePtr->codeStart), \
+ fprintf(stdout, "%2" TCL_Z_MODIFIER "u: %2" TCL_Z_MODIFIER "u (%" TCL_Z_MODIFIER "u) %s ", iPtr->numLevels, \
+ CURR_DEPTH, \
+ (size_t)(pc - codePtr->codeStart), \
GetOpcodeName(pc)); \
printf a; \
TclPrintObject(stdout, objPtr, 30); \
@@ -620,7 +621,7 @@ static const char * GetOpcodeName(const unsigned char *pc);
static void PrintByteCodeInfo(ByteCode *codePtr);
static const char * StringForResultCode(int result);
static void ValidatePcAndStackTop(ByteCode *codePtr,
- const unsigned char *pc, int stackTop,
+ const unsigned char *pc, size_t stackTop,
int checkStack);
#endif /* TCL_COMPILE_DEBUG */
static ByteCode * CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
@@ -1878,8 +1879,8 @@ ArgumentBCEnter(
*----------------------------------------------------------------------
*/
#define bcFramePtr (&TD->cmdFrame)
-#define initCatchTop ((ptrdiff_t *) (TD->stack-1))
-#define initTosPtr ((Tcl_Obj **) (initCatchTop+codePtr->maxExceptDepth))
+#define initCatchTop (TD->stack-1)
+#define initTosPtr (initCatchTop+codePtr->maxExceptDepth)
#define esPtr (iPtr->execEnvPtr->execStackPtr)
int
@@ -1950,7 +1951,7 @@ TclNRExecuteByteCode(
*/
TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL,
- /* cleanup */ INT2PTR(0), INT2PTR(iPtr->evalFlags));
+ /* cleanup */ NULL, INT2PTR(iPtr->evalFlags));
/*
* Reset discard result flag - because it is applicable for this call only,
@@ -2066,7 +2067,7 @@ TEBCresume(
#ifdef TCL_COMPILE_DEBUG
if (!pc && (tclTraceExec >= 2)) {
PrintByteCodeInfo(codePtr);
- fprintf(stdout, " Starting stack top=%d\n", (int) CURR_DEPTH);
+ fprintf(stdout, " Starting stack top=%" TCL_Z_MODIFIER "u\n", CURR_DEPTH);
fflush(stdout);
}
#endif
@@ -2270,7 +2271,7 @@ TEBCresume(
CHECK_STACK();
if (traceInstructions) {
- fprintf(stdout, "%2" TCL_Z_MODIFIER "d: %2d ", iPtr->numLevels, (int) CURR_DEPTH);
+ fprintf(stdout, "%2" TCL_Z_MODIFIER "u: %2" TCL_Z_MODIFIER "u ", iPtr->numLevels, CURR_DEPTH);
TclPrintInstruction(codePtr, pc);
fflush(stdout);
}
@@ -2637,10 +2638,10 @@ TEBCresume(
*/
TclNewObj(objPtr);
- objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(CURR_DEPTH);
+ objPtr->internalRep.twoPtrValue.ptr2 = UINT2PTR(CURR_DEPTH);
objPtr->length = 0;
PUSH_TAUX_OBJ(objPtr);
- TRACE(("=> mark depth as %d\n", (int) CURR_DEPTH));
+ TRACE(("=> mark depth as %" TCL_Z_MODIFIER "u\n", CURR_DEPTH));
NEXT_INST_F(1, 0, 0);
break;
@@ -2652,7 +2653,7 @@ TEBCresume(
*/
CLANG_ASSERT(auxObjList);
- objc = CURR_DEPTH - PTR2INT(auxObjList->internalRep.twoPtrValue.ptr2);
+ objc = CURR_DEPTH - PTR2UINT(auxObjList->internalRep.twoPtrValue.ptr2);
POP_TAUX_OBJ();
#ifdef TCL_COMPILE_DEBUG
/* Ugly abuse! */
@@ -2663,7 +2664,8 @@ TEBCresume(
case INST_EXPAND_STKTOP: {
size_t i;
- ptrdiff_t moved;
+ TEBCdata *newTD;
+ ptrdiff_t oldCatchTopOff, oldTosPtrOff;
/*
* Make sure that the element at stackTop is a list; if not, just
@@ -2692,19 +2694,21 @@ TEBCresume(
+ codePtr->maxStackDepth /* Beyond the original max */
- CURR_DEPTH; /* Relative to where we are */
DECACHE_STACK_INFO();
- moved = GrowEvaluationStack(iPtr->execEnvPtr, length, 1)
- - (Tcl_Obj **) TD;
- if (moved) {
+ oldCatchTopOff = catchTop - initCatchTop;
+ oldTosPtrOff = tosPtr - initTosPtr;
+ newTD = (TEBCdata *)
+ GrowEvaluationStack(iPtr->execEnvPtr, length, 1);
+ if (newTD != TD) {
/*
* 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.
*/
- TD = (TEBCdata *) (((Tcl_Obj **)TD) + moved);
+ TD = newTD;
- catchTop += moved;
- tosPtr += moved;
+ catchTop = initCatchTop + oldCatchTopOff;
+ tosPtr = initTosPtr + oldTosPtrOff;
}
}
@@ -2756,7 +2760,7 @@ TEBCresume(
case INST_INVOKE_EXPANDED:
CLANG_ASSERT(auxObjList);
- objc = CURR_DEPTH - PTR2INT(auxObjList->internalRep.twoPtrValue.ptr2);
+ objc = CURR_DEPTH - PTR2UINT(auxObjList->internalRep.twoPtrValue.ptr2);
POP_TAUX_OBJ();
if (objc) {
pcAdjustment = 1;
@@ -3374,7 +3378,7 @@ TEBCresume(
varPtr->value.objPtr = objResultPtr = newValue;
Tcl_IncrRefCount(newValue);
}
- if (Tcl_ListObjReplace(interp, objResultPtr, len, 0, objc, objv)
+ if (TclListObjAppendElements(interp, objResultPtr, objc, objv)
!= TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
@@ -3432,7 +3436,7 @@ TEBCresume(
} else {
valueToAssign = objResultPtr;
}
- if (Tcl_ListObjReplace(interp, valueToAssign, len, 0,
+ if (TclListObjAppendElements(interp, valueToAssign,
objc, objv) != TCL_OK) {
if (createdNewObj) {
TclDecrRefCount(valueToAssign);
@@ -4655,6 +4659,24 @@ TEBCresume(
valuePtr = OBJ_UNDER_TOS;
TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
+
+ /* special case for ArithSeries */
+ if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) {
+ length = TclArithSeriesObjLength(valuePtr);
+ if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
+ CACHE_STACK_INFO();
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ if (TclArithSeriesObjIndex(valuePtr, index, &objResultPtr) != TCL_OK) {
+ CACHE_STACK_INFO();
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ Tcl_IncrRefCount(objResultPtr); // reference held here
+ goto lindexDone;
+ }
+
/*
* Extract the desired list element.
*/
@@ -4676,6 +4698,8 @@ TEBCresume(
}
objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
+
+ lindexDone:
if (!objResultPtr) {
TRACE_ERROR(interp);
goto gotError;
@@ -4699,6 +4723,28 @@ TEBCresume(
opnd = TclGetInt4AtPtr(pc+1);
TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd));
+ /* special case for ArithSeries */
+ if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) {
+ length = TclArithSeriesObjLength(valuePtr);
+
+ /* Decode end-offset index values. */
+
+ index = TclIndexDecode(opnd, length-1);
+
+ /* Compute value @ index */
+ if (index < length) {
+ if (TclArithSeriesObjIndex(valuePtr, index, &objResultPtr) != TCL_OK) {
+ CACHE_STACK_INFO();
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ } else {
+ TclNewObj(objResultPtr);
+ }
+ pcAdjustment = 5;
+ goto lindexFastPath2;
+ }
+
/*
* Get the contents of the list, making sure that it really is a list
* in the process.
@@ -4721,6 +4767,8 @@ TEBCresume(
TclNewObj(objResultPtr);
}
+ lindexFastPath2:
+
TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
NEXT_INST_F(pcAdjustment, 1, 1);
@@ -4896,7 +4944,15 @@ TEBCresume(
fromIdx = TclIndexDecode(fromIdx, objc - 1);
- objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx);
+ if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) {
+ objResultPtr = TclArithSeriesObjRange(interp, valuePtr, fromIdx, toIdx);
+ if (objResultPtr == NULL) {
+ TRACE_ERROR(interp);
+ goto gotError;
+ }
+ } else {
+ objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx);
+ }
TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
NEXT_INST_F(9, 1, 1);
@@ -4916,13 +4972,17 @@ TEBCresume(
if (length > 0) {
size_t i = 0;
Tcl_Obj *o;
-
+ int isArithSeries = TclHasInternalRep(value2Ptr,&tclArithSeriesType);
/*
* An empty list doesn't match anything.
*/
do {
- Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
+ if (isArithSeries) {
+ TclArithSeriesObjIndex(value2Ptr, i, &o);
+ } else {
+ Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
+ }
if (o != NULL) {
s2 = Tcl_GetStringFromObj(o, &s2len);
} else {
@@ -4932,6 +4992,9 @@ TEBCresume(
if (s1len == s2len) {
match = (memcmp(s1, s2, s1len) == 0);
}
+ if (isArithSeries) {
+ TclDecrRefCount(o);
+ }
i++;
} while (i < length && match == 0);
}
@@ -5774,7 +5837,7 @@ TEBCresume(
* Handle shifts within the native long range.
*/
- if (((size_t) shift < CHAR_BIT*sizeof(long))
+ if (((size_t)shift < CHAR_BIT*sizeof(long))
&& !((w1>0 ? w1 : ~w1) &
-(1UL<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
wResult = (Tcl_WideUInt)w1 << shift;
@@ -6415,10 +6478,10 @@ TEBCresume(
* stack.
*/
- *(++catchTop) = CURR_DEPTH;
- TRACE(("%u => catchTop=%d, stackTop=%d\n",
- TclGetUInt4AtPtr(pc+1), (int) (catchTop - initCatchTop - 1),
- (int) CURR_DEPTH));
+ *(++catchTop) = (Tcl_Obj *)UINT2PTR(CURR_DEPTH);
+ TRACE(("%u => catchTop=%" TCL_Z_MODIFIER "u, stackTop=%" TCL_Z_MODIFIER "u\n",
+ TclGetUInt4AtPtr(pc+1), (size_t)(catchTop - initCatchTop - 1),
+ CURR_DEPTH));
NEXT_INST_F(5, 0, 0);
break;
@@ -6428,7 +6491,7 @@ TEBCresume(
Tcl_ResetResult(interp);
CACHE_STACK_INFO();
result = TCL_OK;
- TRACE(("=> catchTop=%d\n", (int) (catchTop - initCatchTop - 1)));
+ TRACE(("=> catchTop=%" TCL_Z_MODIFIER "u\n", (size_t)(catchTop - initCatchTop - 1)));
NEXT_INST_F(1, 0, 0);
break;
@@ -7330,8 +7393,8 @@ TEBCresume(
while (auxObjList) {
if ((catchTop != initCatchTop)
- && (*catchTop > (ptrdiff_t)
- auxObjList->internalRep.twoPtrValue.ptr2)) {
+ && (PTR2UINT(*catchTop) >
+ PTR2UINT(auxObjList->internalRep.twoPtrValue.ptr2))) {
break;
}
POP_TAUX_OBJ();
@@ -7406,16 +7469,16 @@ TEBCresume(
*/
processCatch:
- while (CURR_DEPTH > *catchTop) {
+ while (CURR_DEPTH > PTR2UINT(*catchTop)) {
valuePtr = POP_OBJECT();
TclDecrRefCount(valuePtr);
}
#ifdef TCL_COMPILE_DEBUG
if (traceInstructions) {
- fprintf(stdout, " ... found catch at %" TCL_Z_MODIFIER "u, catchTop=%d, "
- "unwound to %ld, new pc %" TCL_Z_MODIFIER "u\n",
- rangePtr->codeOffset, (int) (catchTop - initCatchTop - 1),
- (long)*catchTop, rangePtr->catchOffset);
+ fprintf(stdout, " ... found catch at %" TCL_Z_MODIFIER "u, catchTop=%" TCL_Z_MODIFIER "u, "
+ "unwound to %" TCL_Z_MODIFIER "u, new pc %" TCL_Z_MODIFIER "u\n",
+ rangePtr->codeOffset, (size_t)(catchTop - initCatchTop - 1),
+ PTR2UINT(*catchTop), (size_t)rangePtr->catchOffset);
}
#endif
pc = (codePtr->codeStart + rangePtr->catchOffset);
@@ -7452,9 +7515,9 @@ TEBCresume(
if (tosPtr < initTosPtr) {
fprintf(stderr,
"\nTclNRExecuteByteCode: abnormal return at pc %" TCL_Z_MODIFIER "u: "
- "stack top %d < entry stack top %d\n",
+ "stack top %" TCL_Z_MODIFIER "u < entry stack top %d\n",
(size_t)(pc - codePtr->codeStart),
- (int) CURR_DEPTH, 0);
+ CURR_DEPTH, 0);
Tcl_Panic("TclNRExecuteByteCode execution failure: end stack top < start stack top");
}
CLANG_ASSERT(bcFramePtr);
@@ -8691,9 +8754,10 @@ PrintByteCodeInfo(
0.0);
#ifdef TCL_COMPILE_STATS
- fprintf(stdout, " Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_Z_MODIFIER "u+litObj %" TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_Z_MODIFIER "u\n",
+ fprintf(stdout, " Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_Z_MODIFIER
+ "u+litObj %" TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_Z_MODIFIER "u\n",
codePtr->structureSize,
- sizeof(ByteCode)-sizeof(size_t)-sizeof(Tcl_Time),
+ offsetof(ByteCode, localCachePtr),
codePtr->numCodeBytes,
codePtr->numLitObjects * sizeof(Tcl_Obj *),
codePtr->numExceptRanges*sizeof(ExceptionRange),
@@ -8735,20 +8799,21 @@ ValidatePcAndStackTop(
* stdout. */
const unsigned char *pc, /* Points to first byte of a bytecode
* instruction. The program counter. */
- int stackTop, /* Current stack top. Must be between
+ size_t stackTop, /* Current stack top. Must be between
* stackLowerBound and stackUpperBound
* (inclusive). */
int checkStack) /* 0 if the stack depth check should be
* skipped. */
{
- int stackUpperBound = codePtr->maxStackDepth;
+ size_t stackUpperBound = codePtr->maxStackDepth;
/* Greatest legal value for stackTop. */
- size_t relativePc = pc - codePtr->codeStart;
- const unsigned char *codeStart = codePtr->codeStart;
- const unsigned char *codeEnd = codePtr->codeStart + codePtr->numCodeBytes;
+ size_t relativePc = (size_t)(pc - codePtr->codeStart);
+ size_t codeStart = (size_t)codePtr->codeStart;
+ size_t codeEnd = (size_t)
+ (codePtr->codeStart + codePtr->numCodeBytes);
unsigned char opCode = *pc;
- if ((pc < codeStart) || (pc > codeEnd)) {
+ if ((PTR2UINT(pc) < codeStart) || (PTR2UINT(pc) > codeEnd)) {
fprintf(stderr, "\nBad instruction pc 0x%p in TclNRExecuteByteCode\n",
pc);
Tcl_Panic("TclNRExecuteByteCode execution failure: bad pc");
@@ -8759,11 +8824,11 @@ ValidatePcAndStackTop(
Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode");
}
if (checkStack &&
- ((stackTop < 0) || (stackTop > stackUpperBound))) {
+ (stackTop > stackUpperBound)) {
size_t numChars;
const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL);
- fprintf(stderr, "\nBad stack top %d at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode (min 0, max %i)",
+ fprintf(stderr, "\nBad stack top %" TCL_Z_MODIFIER "u at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode (min 0, max %" TCL_Z_MODIFIER "u)",
stackTop, relativePc, stackUpperBound);
if (cmd != NULL) {
Tcl_Obj *message;
@@ -9327,7 +9392,7 @@ EvalStatsCmd(
numCurrentByteCodes =
statsPtr->numCompilations - statsPtr->numByteCodesFreed;
currentHeaderBytes = numCurrentByteCodes
- * (sizeof(ByteCode) - sizeof(size_t) - sizeof(Tcl_Time));
+ * offsetof(ByteCode, localCachePtr);
literalMgmtBytes = sizeof(LiteralTable)
+ (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *))
+ (iPtr->literalTable.numEntries * sizeof(LiteralEntry));
generated by cgit v0.12 at 2025-08-31 14:48:05 (GMT)