diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 50 | ||||
| -rw-r--r-- | generic/tclCompile.c | 4 | ||||
| -rw-r--r-- | generic/tclExecute.c | 4 |
4 files changed, 44 insertions, 21 deletions
@@ -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); |