summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2013-01-05 18:16:06 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2013-01-05 18:16:06 (GMT)
commit6f6055670dd0d873ec34dcd23ae9f8e282fe60aa (patch)
treea526629db720d56fb03f755be004c02ed6b97d35 /generic
parent8ccae052467b3b4ef6a42321289d1a8535c858d5 (diff)
parenta9a9afc838c1d357e9a50c1045a90276f49edb42 (diff)
downloadtcl-6f6055670dd0d873ec34dcd23ae9f8e282fe60aa.zip
tcl-6f6055670dd0d873ec34dcd23ae9f8e282fe60aa.tar.gz
tcl-6f6055670dd0d873ec34dcd23ae9f8e282fe60aa.tar.bz2
merge trunk
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCompCmds.c2
-rw-r--r--generic/tclCompCmdsSZ.c2
-rw-r--r--generic/tclEnsemble.c13
-rw-r--r--generic/tclExecute.c34
4 files changed, 33 insertions, 18 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 8fa191b..752db93 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -3082,7 +3082,7 @@ TclCompileFormatCmd(
* after our attempt to spot a literal).
*/
- for (; --i>=0 ;) {
+ for (; i>=0 ; i--) {
Tcl_DecrRefCount(objv[i]);
}
ckfree(objv);
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 7bead0d..1d04d8b 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -2737,7 +2737,7 @@ TclCompileUnsetCmd(
flags = 1;
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
leadingWord = Tcl_NewObj();
- if (TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {
+ if (numWords > 0 && TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {
int len;
const char *bytes = Tcl_GetStringFromObj(leadingWord, &len);
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 4e2a5cd..9a2d598 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -2956,9 +2956,14 @@ TclCompileEnsemble(
Tcl_ListObjAppendElement(NULL, replaced, replacement);
if (Tcl_ListObjGetElements(NULL, targetCmdObj, &len, &elems) != TCL_OK) {
goto failed;
- }
- if (len != 1) {
- goto failed;
+ } else if (len != 1) {
+ /*
+ * Note that at this point we know we can't issue any special
+ * instruction sequence as the mapping isn't one that we support at
+ * the compiled level.
+ */
+
+ goto cleanup;
}
targetCmdObj = elems[0];
@@ -3011,7 +3016,7 @@ TclCompileEnsemble(
*/
failed:
- if (len == 1 && depth < 250) {
+ if (depth < 250) {
if (depth > 1) {
if (!invokeAnyway) {
cmdPtr = oldCmdPtr;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 3635bab..8759ec9 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -251,13 +251,24 @@ VarHashCreateVar(
* otherwise, push objResultPtr. If (result < 0), objResultPtr already
* has the correct reference count.
*
- * We use the new compile-time assertions to cheack that nCleanup is constant
+ * We use the new compile-time assertions to check that nCleanup is constant
* and within range.
*/
-#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \
+/* Verify the stack depth, only when no expansion is in progress */
+
+#if TCL_COMPILE_DEBUG
+#define CHECK_STACK() \
+ ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH, \
+ /*checkStack*/ auxObjList == NULL)
+#else
+#define CHECK_STACK()
+#endif
+
+#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \
do { \
TCL_CT_ASSERT((nCleanup >= 0) && (nCleanup <= 2)); \
+ CHECK_STACK(); \
if (nCleanup == 0) { \
if (resultHandling != 0) { \
if ((resultHandling) > 0) { \
@@ -286,7 +297,8 @@ VarHashCreateVar(
} \
} while (0)
-#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \
+#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \
+ CHECK_STACK(); \
do { \
pc += (pcAdjustment); \
cleanup = (nCleanup); \
@@ -685,7 +697,7 @@ static void PrintByteCodeInfo(ByteCode *codePtr);
static const char * StringForResultCode(int result);
static void ValidatePcAndStackTop(ByteCode *codePtr,
const unsigned char *pc, int stackTop,
- int stackLowerBound, int checkStack);
+ int checkStack);
#endif /* TCL_COMPILE_DEBUG */
static ByteCode * CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void DeleteExecStack(ExecStack *esPtr);
@@ -2243,8 +2255,7 @@ TEBCresume(
* Skip the stack depth check if an expansion is in progress.
*/
- ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH, 0,
- /*checkStack*/ auxObjList == NULL);
+ CHECK_STACK();
if (traceInstructions) {
fprintf(stdout, "%2d: %2d ", iPtr->numLevels, (int) CURR_DEPTH);
TclPrintInstruction(codePtr, pc);
@@ -8560,11 +8571,10 @@ ValidatePcAndStackTop(
int stackTop, /* Current stack top. Must be between
* stackLowerBound and stackUpperBound
* (inclusive). */
- int stackLowerBound, /* Smallest legal value for stackTop. */
int checkStack) /* 0 if the stack depth check should be
* skipped. */
{
- int stackUpperBound = stackLowerBound + codePtr->maxStackDepth;
+ int stackUpperBound = codePtr->maxStackDepth;
/* Greatest legal value for stackTop. */
unsigned relativePc = (unsigned) (pc - codePtr->codeStart);
unsigned long codeStart = (unsigned long) codePtr->codeStart;
@@ -8582,13 +8592,13 @@ ValidatePcAndStackTop(
(unsigned) opCode, relativePc);
Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode");
}
- if (checkStack &&
- ((stackTop < stackLowerBound) || (stackTop > stackUpperBound))) {
+ if (checkStack &&
+ ((stackTop < 0) || (stackTop > stackUpperBound))) {
int numChars;
const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL);
- fprintf(stderr, "\nBad stack top %d at pc %u in TclNRExecuteByteCode (min %i, max %i)",
- stackTop, relativePc, stackLowerBound, stackUpperBound);
+ fprintf(stderr, "\nBad stack top %d at pc %u in TclNRExecuteByteCode (min 0, max %i)",
+ stackTop, relativePc, stackUpperBound);
if (cmd != NULL) {
Tcl_Obj *message;