summaryrefslogtreecommitdiffstats
path: root/generic/tclDictObj.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2008-07-17 20:43:36 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2008-07-17 20:43:36 (GMT)
commitf30d8e3cdfa9ffef067740f6c285a1dfb246c70d (patch)
tree88613ca85d55f034a29d7a5843b46647092f06de /generic/tclDictObj.c
parent0603043c5b5bc7a0a930f38c71c5e4810f4831f4 (diff)
downloadtcl-f30d8e3cdfa9ffef067740f6c285a1dfb246c70d.zip
tcl-f30d8e3cdfa9ffef067740f6c285a1dfb246c70d.tar.gz
tcl-f30d8e3cdfa9ffef067740f6c285a1dfb246c70d.tar.bz2
NRE-ify the non-compiled version of [dict update].
Diffstat (limited to 'generic/tclDictObj.c')
-rw-r--r--generic/tclDictObj.c49
1 files changed, 40 insertions, 9 deletions
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 570059e..a2cae3a 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclDictObj.c,v 1.59 2008/07/17 15:43:53 dkf Exp $
+ * RCS: @(#) $Id: tclDictObj.c,v 1.60 2008/07/17 20:43:37 dkf Exp $
*/
#include "tclInt.h"
@@ -74,6 +74,8 @@ static inline void DeleteChainTable(struct Dict *dict);
static inline Tcl_HashEntry *CreateChainEntry(struct Dict *dict,
Tcl_Obj *keyPtr, int *newPtr);
static inline int DeleteChainEntry(struct Dict *dict, Tcl_Obj *keyPtr);
+static int FinalizeDictUpdate(ClientData data[],
+ Tcl_Interp *interp, int result);
static int FinalizeDictWith(ClientData data[],
Tcl_Interp *interp, int result);
@@ -2890,8 +2892,7 @@ DictUpdateCmd(
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *dictPtr, *objPtr;
- int i, result, dummy;
- Tcl_InterpState state;
+ int i, dummy;
if (objc < 5 || !(objc & 1)) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -2924,10 +2925,32 @@ DictUpdateCmd(
TclDecrRefCount(dictPtr);
/*
- * Execute the body.
+ * Execute the body after setting up the NRE handler to process the
+ * results.
+ */
+
+ objPtr = Tcl_NewListObj(objc-3, objv+2);
+ Tcl_IncrRefCount(objPtr);
+ TclNR_AddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL,NULL);
+ return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
+}
+
+static int
+FinalizeDictUpdate(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_Obj *dictPtr, *objPtr, **objv;
+ Tcl_InterpState state;
+ int i, objc;
+ Tcl_Obj *varName = data[0];
+ Tcl_Obj *argsObj = data[1];
+
+ /*
+ * ErrorInfo handling.
*/
- result = TclEvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
if (result == TCL_ERROR) {
Tcl_AddErrorInfo(interp, "\n (body of \"dict update\")");
}
@@ -2936,8 +2959,10 @@ DictUpdateCmd(
* If the dictionary variable doesn't exist, drop everything silently.
*/
- dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
+ dictPtr = Tcl_ObjGetVar2(interp, varName, NULL, 0);
if (dictPtr == NULL) {
+ TclDecrRefCount(varName);
+ TclDecrRefCount(argsObj);
return result;
}
@@ -2946,8 +2971,10 @@ DictUpdateCmd(
*/
state = Tcl_SaveInterpState(interp, result);
- if (Tcl_DictObjSize(interp, dictPtr, &dummy) != TCL_OK) {
+ if (Tcl_DictObjSize(interp, dictPtr, &objc) != TCL_OK) {
Tcl_DiscardInterpState(state);
+ TclDecrRefCount(varName);
+ TclDecrRefCount(argsObj);
return TCL_ERROR;
}
@@ -2960,7 +2987,8 @@ DictUpdateCmd(
* an instruction to remove the key.
*/
- for (i=2 ; i+2<objc ; i+=2) {
+ Tcl_ListObjGetElements(NULL, argsObj, &objc, &objv);
+ for (i=0 ; i<objc ; i+=2) {
objPtr = Tcl_ObjGetVar2(interp, objv[i+1], NULL, 0);
if (objPtr == NULL) {
Tcl_DictObjRemove(interp, dictPtr, objv[i]);
@@ -2977,17 +3005,20 @@ DictUpdateCmd(
Tcl_DictObjPut(interp, dictPtr, objv[i], objPtr);
}
}
+ TclDecrRefCount(argsObj);
/*
* Write the dictionary back to its variable.
*/
- if (Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
+ if (Tcl_ObjSetVar2(interp, varName, NULL, dictPtr,
TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_DiscardInterpState(state);
+ TclDecrRefCount(varName);
return TCL_ERROR;
}
+ TclDecrRefCount(varName);
return Tcl_RestoreInterpState(interp, state);
}