Attachment "1786481-2.patch" to
ticket [1786481fff]
added by
msofer
2007-09-11 21:19:47.
? cmdSource.diff
? jeff.chat
? generic/tclInt.h.OK
? generic/tclVar.c.CVS
? generic/tclVar.c.cvs
? unix/0valgrind
? unix/CACHE.res
? unix/CACHE2.res
? unix/CACHE3.res
? unix/CACHE4.res
? unix/ERR
? unix/autom4te.cache
? unix/cachegrind.out.19902
? unix/cachegrind.out.22468
? unix/cachegrind.out.23361
? unix/cachegrind.out.23983
? unix/cachegrind.out.25392
? unix/cachegrind.out.26820
? unix/cachegrind.out.27583
? unix/config.status.lineno
? unix/dltest.marker
? unix/httpd_19974
? unix/tclsh0
? win/autom4te.cache
Index: generic/tclCompCmds.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompCmds.c,v
retrieving revision 1.118
diff -u -r1.118 tclCompCmds.c
--- generic/tclCompCmds.c 9 Sep 2007 16:51:18 -0000 1.118
+++ generic/tclCompCmds.c 11 Sep 2007 14:18:08 -0000
@@ -909,10 +909,12 @@
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 @@
}
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 @@
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 @@
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) {
Index: generic/tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.132
diff -u -r1.132 tclCompile.c
--- generic/tclCompile.c 10 Sep 2007 21:47:20 -0000 1.132
+++ generic/tclCompile.c 11 Sep 2007 14:18:10 -0000
@@ -351,7 +351,7 @@
* 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
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.334
diff -u -r1.334 tclExecute.c
--- generic/tclExecute.c 11 Sep 2007 02:39:35 -0000 1.334
+++ generic/tclExecute.c 11 Sep 2007 14:18:14 -0000
@@ -6698,7 +6698,7 @@
}
CACHE_STACK_INFO();
}
- NEXT_INST_F(9, 1, 0);
+ NEXT_INST_F(9, 0, 0);
case INST_DICT_UPDATE_END:
opnd = TclGetUInt4AtPtr(pc+1);
