summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2011-11-22 13:07:58 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2011-11-22 13:07:58 (GMT)
commitc5a1e89cc8d9f34ca57886a2527f484ed21e3902 (patch)
tree82e967d07b17d8ee34b7bed8845daef57f3c9acd
parentff1b25db81a452f6230211bf47b563173517d4b8 (diff)
downloadtcl-c5a1e89cc8d9f34ca57886a2527f484ed21e3902.zip
tcl-c5a1e89cc8d9f34ca57886a2527f484ed21e3902.tar.gz
tcl-c5a1e89cc8d9f34ca57886a2527f484ed21e3902.tar.bz2
Make some of the logic in TclCompileObj less heavily nested, to improve clarity.
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclExecute.c197
2 files changed, 104 insertions, 100 deletions
diff --git a/ChangeLog b/ChangeLog
index f439c76..76623c2 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,6 +1,11 @@
+2011-11-22 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclExecute.c (TclCompileObj): Simplify and de-indent the
+ logic so that it is easier to comprehend.
+
2011-11-22 Jan Nijtmans <nijtmans@users.sf.net>
- * win/tclWinPort.h: [Bug 2935503] Windows: file mtime
+ * win/tclWinPort.h: [Bug 2935503]: Windows: file mtime
* win/tclWinFile.c: sets wrong time (VS2005+ only)
* generic/tclTest.c:
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index b7c576a..92b6612 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -179,23 +179,25 @@ typedef struct TEBCdata {
Tcl_Obj *auxObjList; /* execution. */
int checkInterp;
CmdFrame cmdFrame;
- void * stack[1]; /* Start of the actual combined catch and obj
+ 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->pc = pc; \
- TD->cleanup = cleanup; \
- TclNRAddCallback(interp, TEBCresume, TD, \
- INT2PTR(1), NULL, NULL)
-
+#define TEBC_YIELD() \
+ do { \
+ esPtr->tosPtr = tosPtr; \
+ TD->pc = pc; \
+ TD->cleanup = cleanup; \
+ TclNRAddCallback(interp, TEBCresume, TD, INT2PTR(1), NULL, NULL); \
+ } while (0)
+
#define TEBC_DATA_DIG() \
- pc = TD->pc; \
- cleanup = TD->cleanup; \
- tosPtr = esPtr->tosPtr
-
+ do { \
+ pc = TD->pc; \
+ cleanup = TD->cleanup; \
+ tosPtr = esPtr->tosPtr; \
+ } while (0)
#define PUSH_TAUX_OBJ(objPtr) \
do { \
@@ -347,7 +349,7 @@ VarHashCreateVar(
#ifdef TCL_COMPILE_DEBUG
# define TRACE(a) \
- while (traceInstructions) { \
+ while (traceInstructions) { \
fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \
(int) CURR_DEPTH, \
(unsigned) (pc - codePtr->codeStart), \
@@ -356,12 +358,12 @@ VarHashCreateVar(
break; \
}
# define TRACE_APPEND(a) \
- while (traceInstructions) { \
+ while (traceInstructions) { \
printf a; \
break; \
}
# define TRACE_WITH_OBJ(a, objPtr) \
- while (traceInstructions) { \
+ while (traceInstructions) { \
fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \
(int) CURR_DEPTH, \
(unsigned) (pc - codePtr->codeStart), \
@@ -387,13 +389,13 @@ VarHashCreateVar(
#define TCL_DTRACE_INST_NEXT() \
do { \
if (TCL_DTRACE_INST_DONE_ENABLED()) { \
- if (curInstName) { \
- TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH, \
+ if (curInstName) { \
+ TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH, \
tosPtr); \
} \
curInstName = tclInstructionTable[*pc].name; \
if (TCL_DTRACE_INST_START_ENABLED()) { \
- TCL_DTRACE_INST_START(curInstName, (int) CURR_DEPTH, \
+ TCL_DTRACE_INST_START(curInstName, (int) CURR_DEPTH, \
tosPtr); \
} \
} else if (TCL_DTRACE_INST_START_ENABLED()) { \
@@ -403,7 +405,7 @@ VarHashCreateVar(
} while (0)
#define TCL_DTRACE_INST_LAST() \
do { \
- if (TCL_DTRACE_INST_DONE_ENABLED() && curInstName) { \
+ if (TCL_DTRACE_INST_DONE_ENABLED() && curInstName) { \
TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH, tosPtr);\
} \
} while (0)
@@ -1257,7 +1259,7 @@ TclStackFree(
eePtr->execStackPtr = esPtr->prevPtr;
} else {
eePtr->execStackPtr = esPtr;
- }
+ }
}
void *
@@ -1591,13 +1593,13 @@ FreeExprCodeInternalRep(
*
* TclCompileObj --
*
- * This procedure compiles the script contained in a Tcl_Obj
+ * This procedure compiles the script contained in a Tcl_Obj.
*
* Results:
* A pointer to the corresponding ByteCode, never NULL.
*
* Side effects:
- * The object is shimmered to bytecode type
+ * The object is shimmered to bytecode type.
*
*----------------------------------------------------------------------
*/
@@ -1642,27 +1644,24 @@ TclCompileObj(
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != namespacePtr)
|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)) {
- if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
- if ((Interp *) *codePtr->interpHandle != iPtr) {
- Tcl_Panic("Tcl_EvalObj: compiled script jumped interps");
- }
- codePtr->compileEpoch = iPtr->compileEpoch;
- } else {
+ if (!(codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
goto recompileObj;
}
+ if ((Interp *) *codePtr->interpHandle != iPtr) {
+ Tcl_Panic("Tcl_EvalObj: compiled script jumped interps");
+ }
+ codePtr->compileEpoch = iPtr->compileEpoch;
}
- if (!(codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
- if (codePtr->procPtr == NULL) {
- /*
- * Check that any compiled locals do refer to the current proc
- * environment! If not, recompile.
- */
+ /*
+ * Check that any compiled locals do refer to the current proc
+ * environment! If not, recompile.
+ */
- if (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr) {
- goto recompileObj;
- }
- }
+ if (!(codePtr->flags & TCL_BYTECODE_PRECOMPILED) &&
+ (codePtr->procPtr == NULL) &&
+ (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)){
+ goto recompileObj;
}
/*
@@ -1694,15 +1693,13 @@ TclCompileObj(
* information.
*/
- if (!invoker) {
+ if (invoker == NULL) {
return codePtr;
- }
-
- {
+ } else {
Tcl_HashEntry *hePtr =
Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
ExtCmdLoc *eclPtr;
- CmdFrame *ctxPtr;
+ CmdFrame *ctxCopyPtr;
int redo;
if (!hePtr) {
@@ -1711,8 +1708,8 @@ TclCompileObj(
eclPtr = Tcl_GetHashValue(hePtr);
redo = 0;
- ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));
- *ctxPtr = *invoker;
+ ctxCopyPtr = TclStackAlloc(interp, sizeof(CmdFrame));
+ *ctxCopyPtr = *invoker;
if (invoker->type == TCL_LOCATION_BC) {
/*
@@ -1720,18 +1717,18 @@ TclCompileObj(
* ctx.data.tebc.codePtr used instead
*/
- TclGetSrcInfoForPc(ctxPtr);
- if (ctxPtr->type == TCL_LOCATION_SOURCE) {
+ TclGetSrcInfoForPc(ctxCopyPtr);
+ if (ctxCopyPtr->type == TCL_LOCATION_SOURCE) {
/*
* The reference made by 'TclGetSrcInfoForPc' is dead.
*/
- Tcl_DecrRefCount(ctxPtr->data.eval.path);
- ctxPtr->data.eval.path = NULL;
+ Tcl_DecrRefCount(ctxCopyPtr->data.eval.path);
+ ctxCopyPtr->data.eval.path = NULL;
}
}
- if (word < ctxPtr->nline) {
+ if (word < ctxCopyPtr->nline) {
/*
* Note: We do not care if the line[word] is -1. This is a
* difference and requires a recompile (location changed from
@@ -1744,12 +1741,12 @@ TclCompileObj(
*/
redo = ((eclPtr->type == TCL_LOCATION_SOURCE)
- && (eclPtr->start != ctxPtr->line[word]))
+ && (eclPtr->start != ctxCopyPtr->line[word]))
|| ((eclPtr->type == TCL_LOCATION_BC)
- && (ctxPtr->type == TCL_LOCATION_SOURCE));
+ && (ctxCopyPtr->type == TCL_LOCATION_SOURCE));
}
- TclStackFree(interp, ctxPtr);
+ TclStackFree(interp, ctxCopyPtr);
if (!redo) {
return codePtr;
}
@@ -1768,7 +1765,7 @@ TclCompileObj(
iPtr->invokeCmdFramePtr = invoker;
iPtr->invokeWord = word;
- tclByteCodeType.setFromAnyProc(interp, objPtr);
+ TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
iPtr->invokeCmdFramePtr = NULL;
codePtr = objPtr->internalRep.otherValuePtr;
if (iPtr->varFramePtr->localCachePtr) {
@@ -1925,7 +1922,7 @@ 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 esPtr (iPtr->execEnvPtr->execStackPtr)
int
TclNRExecuteByteCode(
@@ -1934,15 +1931,15 @@ TclNRExecuteByteCode(
{
Interp *iPtr = (Interp *) interp;
TEBCdata *TD;
- int size = sizeof(TEBCdata) -1 +
+ int size = sizeof(TEBCdata) - 1
+ (codePtr->maxStackDepth + codePtr->maxExceptDepth)
- *(sizeof(void *));
- int numWords = (size + sizeof(Tcl_Obj *) - 1)/sizeof(Tcl_Obj *);
-
+ * sizeof(void *);
+ int numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *);
+
if (iPtr->execEnvPtr->rewind) {
return TCL_ERROR;
}
-
+
codePtr->refCount++;
/*
@@ -1959,14 +1956,14 @@ TclNRExecuteByteCode(
TD = (TEBCdata *) GrowEvaluationStack(iPtr->execEnvPtr, numWords, 0);
esPtr->tosPtr = initTosPtr;
-
+
TD->codePtr = codePtr;
- TD->pc = codePtr->codeStart;
+ TD->pc = codePtr->codeStart;
TD->catchTop = initCatchTop;
TD->cleanup = 0;
TD->auxObjList = NULL;
TD->checkInterp = 0;
-
+
/*
* TIP #280: Initialize the frame. Do not push it yet: it will be pushed
* every time that we call out from this TD, popped when we return to it.
@@ -1993,7 +1990,7 @@ TclNRExecuteByteCode(
/*
* Push the callback for bytecode execution
*/
-
+
TclNRAddCallback(interp, TEBCresume, TD, /*resume*/ INT2PTR(0),
NULL, NULL);
return TCL_OK;
@@ -2035,10 +2032,10 @@ TEBCresume(
int traceInstructions; /* Whether we are doing instruction-level
* tracing or not. */
#endif
-
+
Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
Tcl_Obj **constants = &iPtr->execEnvPtr->constants[0];
-
+
#define LOCAL(i) (&compiledLocals[(i)])
#define TCONST(i) (constants[(i)])
@@ -2050,18 +2047,18 @@ TEBCresume(
TEBCdata *TD = data[0];
#define auxObjList (TD->auxObjList)
#define catchTop (TD->catchTop)
-#define codePtr (TD->codePtr)
+#define codePtr (TD->codePtr)
#define checkInterp (TD->checkInterp)
- /* Indicates when a check of interp readyness
- * is necessary. Set by CACHE_STACK_INFO() */
+ /* Indicates when a check of interp readyness is
+ * necessary. Set by CACHE_STACK_INFO() */
/*
* Globals: variables that store state, must remain valid at all times.
*/
- Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation
- * stack. */
- const unsigned char *pc; /* The current program counter. */
+ Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation
+ * stack. */
+ const unsigned char *pc; /* The current program counter. */
/*
* Transfer variables - needed only between opcodes, but not while
@@ -2125,12 +2122,12 @@ TEBCresume(
* Push the call's object result and continue execution with the
* next instruction.
*/
-
+
TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
- objc, cmdNameBuf), Tcl_GetObjResult(interp));
-
+ objc, cmdNameBuf), Tcl_GetObjResult(interp));
+
objResultPtr = Tcl_GetObjResult(interp);
-
+
/*
* Reset the interp's result to avoid possible duplications of
* large objects [Bug 781585]. We do not call Tcl_ResetResult to
@@ -2141,18 +2138,18 @@ TEBCresume(
* Note that the result object is now in objResultPtr, it keeps
* the refCount it had in its role of iPtr->objResultPtr.
*/
-
+
TclNewObj(objPtr);
Tcl_IncrRefCount(objPtr);
iPtr->objResultPtr = objPtr;
- NEXT_INST_V(0, cleanup, -1);
+ NEXT_INST_V(0, cleanup, -1);
}
-
+
/*
* Result not TCL_OK: fall through
*/
}
-
+
if (iPtr->execEnvPtr->rewind) {
result = TCL_ERROR;
goto abnormalReturn;
@@ -4023,7 +4020,7 @@ TEBCresume(
(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, valuePtr);
- CACHE_STACK_INFO();
+ CACHE_STACK_INFO();
goto gotError;
}
@@ -4032,7 +4029,7 @@ TEBCresume(
(value2Ptr->typePtr? value2Ptr->typePtr->name : "null")));
DECACHE_STACK_INFO();
IllegalExprOperandType(interp, pc, value2Ptr);
- CACHE_STACK_INFO();
+ CACHE_STACK_INFO();
goto gotError;
}
@@ -4424,7 +4421,7 @@ TEBCresume(
s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
memCmpFn = memcmp;
} else if (((valuePtr->typePtr == &tclStringType)
- && (value2Ptr->typePtr == &tclStringType))) {
+ && (value2Ptr->typePtr == &tclStringType))) {
/*
* Do a unicode-specific comparison if both of the args are of
* String type. If the char length == byte length, we can do a
@@ -5219,7 +5216,7 @@ TEBCresume(
NEXT_INST_F(1, 1, 1);
}
- case INST_BITNOT:
+ case INST_BITNOT:
valuePtr = OBJ_AT_TOS;
if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
|| (type1==TCL_NUMBER_NAN) || (type1==TCL_NUMBER_DOUBLE)) {
@@ -6285,10 +6282,10 @@ TEBCresume(
*/
divideByZero:
- DECACHE_STACK_INFO();
+ DECACHE_STACK_INFO();
Tcl_SetResult(interp, "divide by zero", TCL_STATIC);
Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
- CACHE_STACK_INFO();
+ CACHE_STACK_INFO();
goto gotError;
/*
@@ -6297,7 +6294,7 @@ TEBCresume(
*/
exponOfZero:
- DECACHE_STACK_INFO();
+ DECACHE_STACK_INFO();
Tcl_SetResult(interp, "exponentiation of zero by negative power",
TCL_STATIC);
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
@@ -6341,8 +6338,9 @@ TEBCresume(
*/
while (auxObjList) {
- if ((catchTop != initCatchTop) &&
- (*catchTop > ((ptrdiff_t) auxObjList->internalRep.ptrAndLongRep.value))) {
+ if ((catchTop != initCatchTop)
+ && (*catchTop > (ptrdiff_t)
+ auxObjList->internalRep.ptrAndLongRep.value)) {
break;
}
POP_TAUX_OBJ();
@@ -8077,7 +8075,7 @@ TclGetSrcInfoForCmd(
ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc,
- codePtr, lenPtr, NULL);
+ codePtr, lenPtr, NULL);
}
void
@@ -8142,8 +8140,8 @@ static const char *
GetSrcInfoForPc(
const unsigned char *pc, /* The program counter value for which to
* return the closest command's source info.
- * This points within a bytecode instruction in
- * codePtr's code. */
+ * This points within a bytecode instruction
+ * in codePtr's code. */
ByteCode *codePtr, /* The bytecode sequence in which to look up
* the command source for the pc. */
int *lengthPtr, /* If non-NULL, the location where the length
@@ -8233,19 +8231,20 @@ GetSrcInfoForPc(
}
if (pcBeg != NULL) {
- const unsigned char *curr,*prev;
+ const unsigned char *curr, *prev;
- /* Walk from beginning of command or BC to pc, by complete
- * instructions. Stop when crossing pc; keep previous */
+ /*
+ * Walk from beginning of command or BC to pc, by complete
+ * instructions. Stop when crossing pc; keep previous.
+ */
- curr = prev = ((bestDist == INT_MAX) ?
- codePtr->codeStart :
- pc - bestDist);
+ curr = ((bestDist == INT_MAX) ? codePtr->codeStart : pc - bestDist);
+ prev = curr;
while (curr <= pc) {
prev = curr;
curr += tclInstructionTable[*curr].numBytes;
}
- *pcBeg = prev ;
+ *pcBeg = prev;
}
if (bestDist == INT_MAX) {