summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authormsofer <msofer@noemail.net>2007-09-11 14:47:38 (GMT)
committermsofer <msofer@noemail.net>2007-09-11 14:47:38 (GMT)
commit572690991f2addeacb9f9afc1f942e3acb1e93fb (patch)
treeddc061c1b5a86d3df51ba576ba7c448f3dbe6dd9
parent6ee50e14034aecd47f171e4ed9ce1ea9db8ea143 (diff)
downloadtcl-572690991f2addeacb9f9afc1f942e3acb1e93fb.zip
tcl-572690991f2addeacb9f9afc1f942e3acb1e93fb.tar.gz
tcl-572690991f2addeacb9f9afc1f942e3acb1e93fb.tar.bz2
* generic/tclCompCmds.c (TclCompileDictCmd-update):
* generic/tclCompile.c (tclInstructionTable): * generic/tclExecute.c (INST_DICT_UPDATE_END): fix stack management in [dict update] [Bug 1786481]. FossilOrigin-Name: 589c793c6c99244513df0706c9322c4403406173
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclCompCmds.c50
-rw-r--r--generic/tclCompile.c4
-rw-r--r--generic/tclExecute.c4
4 files changed, 44 insertions, 21 deletions
diff --git a/ChangeLog b/ChangeLog
index a2d8c5e..7a28871 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2007-09-11 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclCompCmds.c (TclCompileDictCmd-update):
+ * generic/tclCompile.c (tclInstructionTable):
+ * generic/tclExecute.c (INST_DICT_UPDATE_END): fix stack
+ management in [dict update] [Bug 1786481].
+
2007-09-11 Kevin B. Kenny <kennykb@acm.org>
* generic/tclExecute.c: Corrected an off-by-one error in the
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index dbf3301..67f8961 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.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: tclCompCmds.c,v 1.118 2007/09/09 16:51:18 dgp Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.119 2007/09/11 14:47:41 msofer Exp $
*/
#include "tclInt.h"
@@ -909,10 +909,12 @@ TclCompileDictCmd(
return TCL_OK;
} else if (size==6 && strncmp(cmd, "update", 6)==0) {
const char *name;
- int nameChars, dictIndex, keyTmpIndex, numVars, range, infoIndex;
+ int nameChars, dictIndex, numVars, range, infoIndex;
Tcl_Token **keyTokenPtrs, *dictVarTokenPtr, *bodyTokenPtr;
DictUpdateInfo *duiPtr;
-
+ JumpFixup jumpFixup;
+
+
/*
* Parse the command. Expect the following:
* dict update <lit(eral)> <any> <lit> ?<any> <lit> ...? <lit>
@@ -965,8 +967,6 @@ TclCompileDictCmd(
}
bodyTokenPtr = tokenPtr;
- keyTmpIndex = TclFindCompiledLocal(NULL, 0, 1, procPtr);
-
/*
* The list of variables to bind is stored in auxiliary data so that
* it can't be snagged by literal sharing and forced to shimmer
@@ -979,7 +979,6 @@ TclCompileDictCmd(
CompileWord(envPtr, keyTokenPtrs[i], interp, i);
}
TclEmitInstInt4( INST_LIST, numVars, envPtr);
- TclEmitInstInt4( INST_STORE_SCALAR4, keyTmpIndex, envPtr);
TclEmitInstInt4( INST_DICT_UPDATE_START, dictIndex, envPtr);
TclEmitInt4( infoIndex, envPtr);
@@ -990,27 +989,44 @@ TclCompileDictCmd(
CompileBody(envPtr, bodyTokenPtr, interp);
ExceptionRangeEnds(envPtr, range);
- ExceptionRangeTarget(envPtr, range, catchOffset);
- TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr);
- TclEmitOpcode( INST_PUSH_RESULT, envPtr);
+ /*
+ * Normal termination code: the stack has the key list below the
+ * result of the body evaluation: swap them and finish the update
+ * code.
+ */
+
TclEmitOpcode( INST_END_CATCH, envPtr);
-
- TclEmitInstInt4( INST_LOAD_SCALAR4, keyTmpIndex, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 2, envPtr);
+ TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr);
+ TclEmitInt4( infoIndex, envPtr);
/*
- * Now remove the contents of the temporary key variable so that the
- * reference counts of the keys end up correct. Unsetting the variable
- * would be better, but there's no opcode for that.
+ * Jump around the exceptional termination code
*/
+
+ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
- PushLiteral(envPtr, "", 0);
- TclEmitInstInt4( INST_STORE_SCALAR4, keyTmpIndex, envPtr);
- TclEmitOpcode( INST_POP, envPtr);
+ /*
+ * Termination code for non-ok returns: stash the result and return
+ * options in the stack, bring up the key list, finish the update
+ * code, and finally return with the catched return data
+ */
+
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ TclEmitOpcode( INST_PUSH_RESULT, envPtr);
+ TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr);
+ TclEmitOpcode( INST_END_CATCH, envPtr);
+ TclEmitInstInt4( INST_REVERSE, 3, envPtr);
TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr);
TclEmitInt4( infoIndex, envPtr);
TclEmitOpcode( INST_RETURN_STK, envPtr);
+
+ if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
+ Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
+ CurrentOffset(envPtr) - jumpFixup.codeOffset);
+ }
TclStackFree(interp, keyTokenPtrs);
return TCL_OK;
} else if (size==6 && strncmp(cmd, "append", 6) == 0) {
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 820642f..6ae3aaf 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.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: tclCompile.c,v 1.132 2007/09/10 21:47:20 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.133 2007/09/11 14:47:42 msofer Exp $
*/
#include "tclInt.h"
@@ -351,7 +351,7 @@ InstructionDesc tclInstructionTable[] = {
* Stack: ... => ... value key doneBool */
{"dictDone", 5, 0, 1, {OPERAND_LVT4}},
/* Terminate the iterator in op4's local scalar. */
- {"dictUpdateStart", 9, -1, 2, {OPERAND_LVT4, OPERAND_AUX4}},
+ {"dictUpdateStart", 9, 0, 2, {OPERAND_LVT4, OPERAND_AUX4}},
/* Create the variables (described in the aux data referred to by the
* second immediate argument) to mirror the state of the dictionary in
* the variable referred to by the first immediate argument. The list
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 1d48e9c..d2bec9b 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.334 2007/09/11 02:39:35 kennykb Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.335 2007/09/11 14:47:43 msofer Exp $
*/
#include "tclInt.h"
@@ -6698,7 +6698,7 @@ TclExecuteByteCode(
}
CACHE_STACK_INFO();
}
- NEXT_INST_F(9, 1, 0);
+ NEXT_INST_F(9, 0, 0);
case INST_DICT_UPDATE_END:
opnd = TclGetUInt4AtPtr(pc+1);