summaryrefslogtreecommitdiffstats
path: root/generic/tclDictObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclDictObj.c')
-rw-r--r--generic/tclDictObj.c1098
1 files changed, 294 insertions, 804 deletions
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 327c159..4fec2c1 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -4,7 +4,7 @@
* This file contains functions that implement the Tcl dict object type
* and its accessor command.
*
- * Copyright (c) 2002-2010 by Donal K. Fellows.
+ * Copyright (c) 2002 by Donal K. Fellows.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -23,26 +23,44 @@ struct Dict;
*/
static void DeleteDict(struct Dict *dict);
-static Tcl_ObjCmdProc DictAppendCmd;
-static Tcl_ObjCmdProc DictCreateCmd;
-static Tcl_ObjCmdProc DictExistsCmd;
-static Tcl_ObjCmdProc DictFilterCmd;
-static Tcl_ObjCmdProc DictForNRCmd;
-static Tcl_ObjCmdProc DictGetCmd;
-static Tcl_ObjCmdProc DictIncrCmd;
-static Tcl_ObjCmdProc DictInfoCmd;
-static Tcl_ObjCmdProc DictKeysCmd;
-static Tcl_ObjCmdProc DictLappendCmd;
-static Tcl_ObjCmdProc DictMapNRCmd;
-static Tcl_ObjCmdProc DictMergeCmd;
-static Tcl_ObjCmdProc DictRemoveCmd;
-static Tcl_ObjCmdProc DictReplaceCmd;
-static Tcl_ObjCmdProc DictSetCmd;
-static Tcl_ObjCmdProc DictSizeCmd;
-static Tcl_ObjCmdProc DictUnsetCmd;
-static Tcl_ObjCmdProc DictUpdateCmd;
-static Tcl_ObjCmdProc DictValuesCmd;
-static Tcl_ObjCmdProc DictWithCmd;
+static int DictAppendCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictCreateCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictExistsCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictFilterCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictForCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictGetCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictIncrCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictInfoCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictKeysCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictLappendCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictMergeCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictRemoveCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictReplaceCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictSetCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictSizeCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictUnsetCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictUpdateCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictValuesCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
+static int DictWithCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
static void DupDictInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void FreeDictInternalRep(Tcl_Obj *dictPtr);
static void InvalidateDictChain(Tcl_Obj *dictObj);
@@ -54,41 +72,32 @@ 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);
-static int DictForLoopCallback(ClientData data[],
- Tcl_Interp *interp, int result);
-static int DictMapLoopCallback(ClientData data[],
- Tcl_Interp *interp, int result);
/*
* Table of dict subcommand names and implementations.
*/
static const EnsembleImplMap implementationMap[] = {
- {"append", DictAppendCmd, TclCompileDictAppendCmd, NULL, NULL, 0 },
- {"create", DictCreateCmd, TclCompileDictCreateCmd, NULL, NULL, 0 },
- {"exists", DictExistsCmd, TclCompileDictExistsCmd, NULL, NULL, 0 },
- {"filter", DictFilterCmd, NULL, NULL, NULL, 0 },
- {"for", NULL, TclCompileDictForCmd, DictForNRCmd, NULL, 0 },
- {"get", DictGetCmd, TclCompileDictGetCmd, NULL, NULL, 0 },
- {"incr", DictIncrCmd, TclCompileDictIncrCmd, NULL, NULL, 0 },
- {"info", DictInfoCmd, NULL, NULL, NULL, 0 },
- {"keys", DictKeysCmd, NULL, NULL, NULL, 0 },
- {"lappend", DictLappendCmd, TclCompileDictLappendCmd, NULL, NULL, 0 },
- {"map", NULL, TclCompileDictMapCmd, DictMapNRCmd, NULL, 0 },
- {"merge", DictMergeCmd, TclCompileDictMergeCmd, NULL, NULL, 0 },
- {"remove", DictRemoveCmd, NULL, NULL, NULL, 0 },
- {"replace", DictReplaceCmd, NULL, NULL, NULL, 0 },
- {"set", DictSetCmd, TclCompileDictSetCmd, NULL, NULL, 0 },
- {"size", DictSizeCmd, NULL, NULL, NULL, 0 },
- {"unset", DictUnsetCmd, TclCompileDictUnsetCmd, NULL, NULL, 0 },
- {"update", DictUpdateCmd, TclCompileDictUpdateCmd, NULL, NULL, 0 },
- {"values", DictValuesCmd, NULL, NULL, NULL, 0 },
- {"with", DictWithCmd, TclCompileDictWithCmd, NULL, NULL, 0 },
- {NULL, NULL, NULL, NULL, NULL, 0}
+ {"append", DictAppendCmd, TclCompileDictAppendCmd },
+ {"create", DictCreateCmd, NULL },
+ {"exists", DictExistsCmd, NULL },
+ {"filter", DictFilterCmd, NULL },
+ {"for", DictForCmd, TclCompileDictForCmd },
+ {"get", DictGetCmd, TclCompileDictGetCmd },
+ {"incr", DictIncrCmd, TclCompileDictIncrCmd },
+ {"info", DictInfoCmd, NULL },
+ {"keys", DictKeysCmd, NULL },
+ {"lappend", DictLappendCmd, TclCompileDictLappendCmd },
+ {"merge", DictMergeCmd, NULL },
+ {"remove", DictRemoveCmd, NULL },
+ {"replace", DictReplaceCmd, NULL },
+ {"set", DictSetCmd, TclCompileDictSetCmd },
+ {"size", DictSizeCmd, NULL },
+ {"unset", DictUnsetCmd, NULL },
+ {"update", DictUpdateCmd, TclCompileDictUpdateCmd },
+ {"values", DictValuesCmd, NULL },
+ {"with", DictWithCmd, NULL },
+ {NULL, NULL, NULL}
};
/*
@@ -139,10 +148,10 @@ typedef struct Dict {
* functions that can be invoked by generic object code.
*/
-const Tcl_ObjType tclDictType = {
+Tcl_ObjType tclDictType = {
"dict",
FreeDictInternalRep, /* freeIntRepProc */
- DupDictInternalRep, /* dupIntRepProc */
+ DupDictInternalRep, /* dupIntRepProc */
UpdateStringOfDict, /* updateStringProc */
SetDictFromAny /* setFromAnyProc */
};
@@ -157,7 +166,7 @@ const Tcl_ObjType tclDictType = {
* *this* file. Everything else should use the dict iterator API.
*/
-static const Tcl_HashKeyType chainHashType = {
+static Tcl_HashKeyType chainHashType = {
TCL_HASH_KEY_TYPE_VERSION,
0,
TclHashObjKey,
@@ -165,23 +174,6 @@ static const Tcl_HashKeyType chainHashType = {
AllocChainEntry,
TclFreeObjEntry
};
-
-/*
- * Structure used in implementation of 'dict map' to hold the state that gets
- * passed between parts of the implementation.
- */
-
-typedef struct {
- Tcl_Obj *keyVarObj; /* The name of the variable that will have
- * keys assigned to it. */
- Tcl_Obj *valueVarObj; /* The name of the variable that will have
- * values assigned to it. */
- Tcl_DictSearch search; /* The dictionary search structure. */
- Tcl_Obj *scriptObj; /* The script to evaluate each time through
- * the loop. */
- Tcl_Obj *accumulatorObj; /* The dictionary used to accumulate the
- * results. */
-} DictMapStorage;
/***** START OF FUNCTIONS IMPLEMENTING DICT CORE API *****/
@@ -211,8 +203,8 @@ AllocChainEntry(
Tcl_Obj *objPtr = keyPtr;
ChainEntry *cPtr;
- cPtr = ckalloc(sizeof(ChainEntry));
- cPtr->entry.key.objPtr = objPtr;
+ cPtr = (ChainEntry *) ckalloc(sizeof(ChainEntry));
+ cPtr->entry.key.oneWordValue = (char *) objPtr;
Tcl_IncrRefCount(objPtr);
cPtr->entry.clientData = NULL;
cPtr->prevPtr = cPtr->nextPtr = NULL;
@@ -258,7 +250,7 @@ CreateChainEntry(
int *newPtr)
{
ChainEntry *cPtr = (ChainEntry *)
- Tcl_CreateHashEntry(&dict->table, keyPtr, newPtr);
+ Tcl_CreateHashEntry(&dict->table, (char *) keyPtr, newPtr);
/*
* If this is a new entry in the hash table, stitch it into the chain.
@@ -286,7 +278,7 @@ DeleteChainEntry(
Tcl_Obj *keyPtr)
{
ChainEntry *cPtr = (ChainEntry *)
- Tcl_FindHashEntry(&dict->table, keyPtr);
+ Tcl_FindHashEntry(&dict->table, (char *) keyPtr);
if (cPtr == NULL) {
return 0;
@@ -341,8 +333,8 @@ DupDictInternalRep(
Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr)
{
- Dict *oldDict = srcPtr->internalRep.otherValuePtr;
- Dict *newDict = ckalloc(sizeof(Dict));
+ Dict *oldDict = srcPtr->internalRep.twoPtrValue.ptr1;
+ Dict *newDict = (Dict *) ckalloc(sizeof(Dict));
ChainEntry *cPtr;
/*
@@ -351,7 +343,7 @@ DupDictInternalRep(
InitChainTable(newDict);
for (cPtr=oldDict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) {
- Tcl_Obj *key = Tcl_GetHashKey(&oldDict->table, &cPtr->entry);
+ void *key = Tcl_GetHashKey(&oldDict->table, &cPtr->entry);
Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
int n;
Tcl_HashEntry *hPtr = CreateChainEntry(newDict, key, &n);
@@ -360,7 +352,7 @@ DupDictInternalRep(
* Fill in the contents.
*/
- Tcl_SetHashValue(hPtr, valuePtr);
+ Tcl_SetHashValue(hPtr, (ClientData) valuePtr);
Tcl_IncrRefCount(valuePtr);
}
@@ -376,7 +368,7 @@ DupDictInternalRep(
* Store in the object.
*/
- copyPtr->internalRep.otherValuePtr = newDict;
+ copyPtr->internalRep.twoPtrValue.ptr1 = newDict;
copyPtr->typePtr = &tclDictType;
}
@@ -402,14 +394,12 @@ static void
FreeDictInternalRep(
Tcl_Obj *dictPtr)
{
- Dict *dict = dictPtr->internalRep.otherValuePtr;
+ Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1;
- dict->refcount--;
+ --dict->refcount;
if (dict->refcount <= 0) {
DeleteDict(dict);
}
-
- dictPtr->internalRep.otherValuePtr = NULL; /* Belt and braces! */
dictPtr->typePtr = NULL;
}
@@ -438,7 +428,7 @@ DeleteDict(
Dict *dict)
{
DeleteChainTable(dict);
- ckfree(dict);
+ ckfree((char *) dict);
}
/*
@@ -469,14 +459,12 @@ UpdateStringOfDict(
{
#define LOCAL_SIZE 20
int localFlags[LOCAL_SIZE], *flagPtr = NULL;
- Dict *dict = dictPtr->internalRep.otherValuePtr;
+ Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1;
ChainEntry *cPtr;
Tcl_Obj *keyPtr, *valuePtr;
- int i, bytesNeeded = 0;
- const char *elem;
- char *dst;
+ int i, length, bytesNeeded = 0;
+ char *elem, *dst;
const int maxFlags = UINT_MAX / sizeof(int);
- size_t length;
/*
* This field is the most useful one in the whole hash structure, and it
@@ -501,7 +489,7 @@ UpdateStringOfDict(
} else if (numElems > maxFlags) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
} else {
- flagPtr = ckalloc(numElems * sizeof(int));
+ flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
}
for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
/*
@@ -510,7 +498,7 @@ UpdateStringOfDict(
*/
flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
- keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
+ keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, &cPtr->entry);
elem = TclGetStringFromObj(keyPtr, &length);
bytesNeeded += TclScanElement(elem, length, flagPtr+i);
if (bytesNeeded < 0) {
@@ -535,11 +523,11 @@ UpdateStringOfDict(
*/
dictPtr->length = bytesNeeded - 1;
- dictPtr->bytes = ckalloc(bytesNeeded);
+ dictPtr->bytes = ckalloc((unsigned) bytesNeeded);
dst = dictPtr->bytes;
for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
- keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
+ keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, &cPtr->entry);
elem = TclGetStringFromObj(keyPtr, &length);
dst += TclConvertElement(elem, length, dst, flagPtr[i]);
*dst++ = ' ';
@@ -553,7 +541,7 @@ UpdateStringOfDict(
dictPtr->bytes[dictPtr->length] = '\0';
if (flagPtr != localFlags) {
- ckfree(flagPtr);
+ ckfree((char *) flagPtr);
}
}
@@ -584,7 +572,7 @@ SetDictFromAny(
{
Tcl_HashEntry *hPtr;
int isNew, result;
- Dict *dict = ckalloc(sizeof(Dict));
+ Dict *dict = (Dict *) ckalloc(sizeof(Dict));
InitChainTable(dict);
@@ -595,7 +583,7 @@ SetDictFromAny(
*/
if (objPtr->typePtr == &tclListType) {
- size_t objc, i;
+ int objc, i;
Tcl_Obj **objv;
/* Cannot fail, we already know the Tcl_ObjType is "list". */
@@ -605,7 +593,7 @@ SetDictFromAny(
}
for (i=0 ; i<objc ; i+=2) {
-
+
/* Store key and value in the hash table we're building. */
hPtr = CreateChainEntry(dict, objv[i], &isNew);
if (!isNew) {
@@ -625,15 +613,14 @@ SetDictFromAny(
Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */
}
} else {
- size_t length;
+ int length;
const char *nextElem = TclGetStringFromObj(objPtr, &length);
const char *limit = (nextElem + length);
while (nextElem < limit) {
Tcl_Obj *keyPtr, *valuePtr;
const char *elemStart;
- size_t elemSize;
- int literal;
+ int elemSize, literal;
result = TclFindElement(interp, nextElem, (limit - nextElem),
&elemStart, &nextElem, &elemSize, &literal);
@@ -697,24 +684,19 @@ SetDictFromAny(
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- objPtr->internalRep.otherValuePtr = dict;
+ objPtr->internalRep.twoPtrValue.ptr1 = dict;
objPtr->typePtr = &tclDictType;
return TCL_OK;
missingValue:
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "missing value to go with key", TCL_STRLEN));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
+ Tcl_SetResult(interp, "missing value to go with key", TCL_STATIC);
}
result = TCL_ERROR;
errorExit:
- if (interp != NULL) {
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
- }
DeleteChainTable(dict);
- ckfree(dict);
+ ckfree((char *) dict);
return result;
}
@@ -754,7 +736,7 @@ Tcl_Obj *
TclTraceDictPath(
Tcl_Interp *interp,
Tcl_Obj *dictPtr,
- size_t keyc,
+ int keyc,
Tcl_Obj *const keyv[],
int flags)
{
@@ -766,13 +748,13 @@ TclTraceDictPath(
return NULL;
}
}
- dict = dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
if (flags & DICT_PATH_UPDATE) {
dict->chain = NULL;
}
for (i=0 ; i<keyc ; i++) {
- Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&dict->table, keyv[i]);
+ Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&dict->table, (char *)keyv[i]);
Tcl_Obj *tmpObj;
if (hPtr == NULL) {
@@ -783,9 +765,9 @@ TclTraceDictPath(
}
if ((flags & DICT_PATH_CREATE) != DICT_PATH_CREATE) {
if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "key \"%s\" not known in dictionary",
- TclGetString(keyv[i])));
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "key \"", TclGetString(keyv[i]),
+ "\" not known in dictionary", NULL);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
TclGetString(keyv[i]), NULL);
}
@@ -809,15 +791,15 @@ TclTraceDictPath(
}
}
- newDict = tmpObj->internalRep.otherValuePtr;
+ newDict = tmpObj->internalRep.twoPtrValue.ptr1;
if (flags & DICT_PATH_UPDATE) {
if (Tcl_IsShared(tmpObj)) {
TclDecrRefCount(tmpObj);
tmpObj = Tcl_DuplicateObj(tmpObj);
Tcl_IncrRefCount(tmpObj);
- Tcl_SetHashValue(hPtr, tmpObj);
+ Tcl_SetHashValue(hPtr, (ClientData) tmpObj);
dict->epoch++;
- newDict = tmpObj->internalRep.otherValuePtr;
+ newDict = tmpObj->internalRep.twoPtrValue.ptr1;
}
newDict->chain = dictPtr;
@@ -852,17 +834,17 @@ static void
InvalidateDictChain(
Tcl_Obj *dictObj)
{
- Dict *dict = dictObj->internalRep.otherValuePtr;
+ Dict *dict = dictObj->internalRep.twoPtrValue.ptr1;
do {
- Tcl_InvalidateStringRep(dictObj);
+ TclInvalidateStringRep(dictObj);
dict->epoch++;
dictObj = dict->chain;
if (dictObj == NULL) {
break;
}
dict->chain = NULL;
- dict = dictObj->internalRep.otherValuePtr;
+ dict = dictObj->internalRep.twoPtrValue.ptr1;
} while (dict != NULL);
}
@@ -909,9 +891,9 @@ Tcl_DictObjPut(
}
if (dictPtr->bytes != NULL) {
- Tcl_InvalidateStringRep(dictPtr);
+ TclInvalidateStringRep(dictPtr);
}
- dict = dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
hPtr = CreateChainEntry(dict, keyPtr, &isNew);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
@@ -962,8 +944,8 @@ Tcl_DictObjGet(
}
}
- dict = dictPtr->internalRep.otherValuePtr;
- hPtr = Tcl_FindHashEntry(&dict->table, keyPtr);
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
+ hPtr = Tcl_FindHashEntry(&dict->table, (char *) keyPtr);
if (hPtr == NULL) {
*valuePtrPtr = NULL;
} else {
@@ -1011,9 +993,9 @@ Tcl_DictObjRemove(
}
if (dictPtr->bytes != NULL) {
- Tcl_InvalidateStringRep(dictPtr);
+ TclInvalidateStringRep(dictPtr);
}
- dict = dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
if (DeleteChainEntry(dict, keyPtr)) {
dict->epoch++;
}
@@ -1042,7 +1024,7 @@ int
Tcl_DictObjSize(
Tcl_Interp *interp,
Tcl_Obj *dictPtr,
- size_t *sizePtr)
+ int *sizePtr)
{
Dict *dict;
@@ -1053,7 +1035,7 @@ Tcl_DictObjSize(
}
}
- dict = dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
*sizePtr = dict->table.numEntries;
return TCL_OK;
}
@@ -1108,7 +1090,7 @@ Tcl_DictObjFirst(
}
}
- dict = dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
cPtr = dict->entryChainHead;
if (cPtr == NULL) {
searchPtr->epoch = -1;
@@ -1120,7 +1102,8 @@ Tcl_DictObjFirst(
searchPtr->next = cPtr->nextPtr;
dict->refcount++;
if (keyPtrPtr != NULL) {
- *keyPtrPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
+ *keyPtrPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table,
+ &cPtr->entry);
}
if (valuePtrPtr != NULL) {
*valuePtrPtr = Tcl_GetHashValue(&cPtr->entry);
@@ -1196,7 +1179,7 @@ Tcl_DictObjNext(
searchPtr->next = cPtr->nextPtr;
*donePtr = 0;
if (keyPtrPtr != NULL) {
- *keyPtrPtr = Tcl_GetHashKey(
+ *keyPtrPtr = (Tcl_Obj *) Tcl_GetHashKey(
&((Dict *)searchPtr->dictionaryPtr)->table, &cPtr->entry);
}
if (valuePtrPtr != NULL) {
@@ -1263,7 +1246,7 @@ int
Tcl_DictObjPutKeyList(
Tcl_Interp *interp,
Tcl_Obj *dictPtr,
- size_t keyc,
+ int keyc,
Tcl_Obj *const keyv[],
Tcl_Obj *valuePtr)
{
@@ -1283,7 +1266,7 @@ Tcl_DictObjPutKeyList(
return TCL_ERROR;
}
- dict = dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
@@ -1322,7 +1305,7 @@ int
Tcl_DictObjRemoveKeyList(
Tcl_Interp *interp,
Tcl_Obj *dictPtr,
- size_t keyc,
+ int keyc,
Tcl_Obj *const keyv[])
{
Dict *dict;
@@ -1339,7 +1322,7 @@ Tcl_DictObjRemoveKeyList(
return TCL_ERROR;
}
- dict = dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
DeleteChainEntry(dict, keyv[keyc-1]);
InvalidateDictChain(dictPtr);
return TCL_OK;
@@ -1379,13 +1362,13 @@ Tcl_NewDictObj(void)
Dict *dict;
TclNewObj(dictPtr);
- Tcl_InvalidateStringRep(dictPtr);
- dict = ckalloc(sizeof(Dict));
+ TclInvalidateStringRep(dictPtr);
+ dict = (Dict *) ckalloc(sizeof(Dict));
InitChainTable(dict);
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- dictPtr->internalRep.otherValuePtr = dict;
+ dictPtr->internalRep.twoPtrValue.ptr1 = dict;
dictPtr->typePtr = &tclDictType;
return dictPtr;
#endif
@@ -1428,13 +1411,13 @@ Tcl_DbNewDictObj(
Dict *dict;
TclDbNewObj(dictPtr, file, line);
- Tcl_InvalidateStringRep(dictPtr);
- dict = ckalloc(sizeof(Dict));
+ TclInvalidateStringRep(dictPtr);
+ dict = (Dict *) ckalloc(sizeof(Dict));
InitChainTable(dict);
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- dictPtr->internalRep.otherValuePtr = dict;
+ dictPtr->internalRep.twoPtrValue.ptr1 = dict;
dictPtr->typePtr = &tclDictType;
return dictPtr;
#else /* !TCL_MEM_DEBUG */
@@ -1466,7 +1449,7 @@ static int
DictCreateCmd(
ClientData dummy,
Tcl_Interp *interp,
- size_t objc,
+ int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictObj;
@@ -1516,14 +1499,14 @@ static int
DictGetCmd(
ClientData dummy,
Tcl_Interp *interp,
- size_t objc,
+ int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr = NULL;
int result;
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key key ...?");
return TCL_ERROR;
}
@@ -1534,7 +1517,7 @@ DictGetCmd(
*/
if (objc == 2) {
- Tcl_Obj *keyPtr = NULL, *listPtr;
+ Tcl_Obj *keyPtr, *listPtr;
Tcl_DictSearch search;
int done;
@@ -1576,11 +1559,9 @@ DictGetCmd(
return result;
}
if (valuePtr == NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "key \"%s\" not known in dictionary",
- TclGetString(objv[objc-1])));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
- TclGetString(objv[objc-1]), NULL);
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "key \"", TclGetString(objv[objc-1]),
+ "\" not known in dictionary", NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, valuePtr);
@@ -1609,7 +1590,7 @@ static int
DictReplaceCmd(
ClientData dummy,
Tcl_Interp *interp,
- size_t objc,
+ int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
@@ -1661,7 +1642,7 @@ static int
DictRemoveCmd(
ClientData dummy,
Tcl_Interp *interp,
- size_t objc,
+ int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
@@ -1713,10 +1694,10 @@ static int
DictMergeCmd(
ClientData dummy,
Tcl_Interp *interp,
- size_t objc,
+ int objc,
Tcl_Obj *const *objv)
{
- Tcl_Obj *targetObj, *keyObj = NULL, *valueObj = NULL;
+ Tcl_Obj *targetObj, *keyObj, *valueObj;
int allocatedDict = 0;
int i, done;
Tcl_DictSearch search;
@@ -1802,11 +1783,11 @@ static int
DictKeysCmd(
ClientData dummy,
Tcl_Interp *interp,
- size_t objc,
+ int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *listPtr;
- const char *pattern = NULL;
+ char *pattern = NULL;
if (objc!=2 && objc!=3) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?pattern?");
@@ -1840,8 +1821,8 @@ DictKeysCmd(
}
} else {
Tcl_DictSearch search;
- Tcl_Obj *keyPtr = NULL;
- int done = 0;
+ Tcl_Obj *keyPtr;
+ int done;
/*
* At this point, we know we have a dictionary (or at least something
@@ -1885,13 +1866,13 @@ static int
DictValuesCmd(
ClientData dummy,
Tcl_Interp *interp,
- size_t objc,
+ int objc,
Tcl_Obj *const *objv)
{
- Tcl_Obj *valuePtr = NULL, *listPtr;
+ Tcl_Obj *valuePtr, *listPtr;
Tcl_DictSearch search;
int done;
- const char *pattern;
+ char *pattern;
if (objc!=2 && objc!=3) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?pattern?");
@@ -1945,11 +1926,10 @@ static int
DictSizeCmd(
ClientData dummy,
Tcl_Interp *interp,
- size_t objc,
+ int objc,
Tcl_Obj *const *objv)
{
- int result;
- size_t size;
+ int result, size;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
@@ -1984,7 +1964,7 @@ static int
DictExistsCmd(
ClientData dummy,
Tcl_Interp *interp,
- size_t objc,
+ int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr;
@@ -2028,12 +2008,11 @@ static int
DictInfoCmd(
ClientData dummy,
Tcl_Interp *interp,
- size_t objc,
+ int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
Dict *dict;
- char *statsStr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
@@ -2047,11 +2026,13 @@ DictInfoCmd(
return result;
}
}
- dict = dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
- statsStr = Tcl_HashStats(&dict->table);
- Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, TCL_STRLEN));
- ckfree(statsStr);
+ /*
+ * This next cast is actually OK.
+ */
+
+ Tcl_SetResult(interp, (char *) Tcl_HashStats(&dict->table), TCL_DYNAMIC);
return TCL_OK;
}
@@ -2077,7 +2058,7 @@ static int
DictIncrCmd(
ClientData dummy,
Tcl_Interp *interp,
- size_t objc,
+ int objc,
Tcl_Obj *const *objv)
{
int code = TCL_OK;
@@ -2162,7 +2143,7 @@ DictIncrCmd(
}
}
if (code == TCL_OK) {
- Tcl_InvalidateStringRep(dictPtr);
+ TclInvalidateStringRep(dictPtr);
valuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL,
dictPtr, TCL_LEAVE_ERR_MSG);
if (valuePtr == NULL) {
@@ -2198,7 +2179,7 @@ static int
DictLappendCmd(
ClientData dummy,
Tcl_Interp *interp,
- size_t objc,
+ int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
@@ -2251,7 +2232,7 @@ DictLappendCmd(
if (allocatedValue) {
Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
} else if (dictPtr->bytes != NULL) {
- Tcl_InvalidateStringRep(dictPtr);
+ TclInvalidateStringRep(dictPtr);
}
resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
@@ -2285,7 +2266,7 @@ static int
DictAppendCmd(
ClientData dummy,
Tcl_Interp *interp,
- size_t objc,
+ int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
@@ -2338,9 +2319,9 @@ DictAppendCmd(
/*
*----------------------------------------------------------------------
*
- * DictForNRCmd --
+ * DictForCmd --
*
- * These functions implement the "dict for" Tcl command. See the user
+ * This function implements the "dict for" Tcl command. See the user
* documentation for details on what it does, and TIP#111 for the formal
* specification.
*
@@ -2354,18 +2335,17 @@ DictAppendCmd(
*/
static int
-DictForNRCmd(
+DictForCmd(
ClientData dummy,
Tcl_Interp *interp,
- size_t objc,
+ int objc,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
Tcl_Obj **varv, *keyObj, *valueObj;
- Tcl_DictSearch *searchPtr;
- size_t varc;
- int done;
+ Tcl_DictSearch search;
+ int varc, done, result;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -2373,33 +2353,23 @@ DictForNRCmd(
return TCL_ERROR;
}
- /*
- * Parse arguments.
- */
-
if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
return TCL_ERROR;
}
if (varc != 2) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "must have exactly two variable names", TCL_STRLEN));
- return TCL_ERROR;
- }
- searchPtr = TclStackAlloc(interp, sizeof(Tcl_DictSearch));
- if (Tcl_DictObjFirst(interp, objv[2], searchPtr, &keyObj, &valueObj,
- &done) != TCL_OK) {
- TclStackFree(interp, searchPtr);
+ Tcl_SetResult(interp, "must have exactly two variable names",
+ TCL_STATIC);
return TCL_ERROR;
}
- if (done) {
- TclStackFree(interp, searchPtr);
- return TCL_OK;
- }
- TclListObjGetElements(NULL, objv[1], &varc, &varv);
keyVarObj = varv[0];
valueVarObj = varv[1];
scriptObj = objv[3];
+ if (Tcl_DictObjFirst(interp, objv[2], &search, &keyObj, &valueObj,
+ &done) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
/*
* Make sure that these objects (which we need throughout the body of the
* loop) don't vanish. Note that the dictionary internal rep is locked
@@ -2410,333 +2380,64 @@ DictForNRCmd(
Tcl_IncrRefCount(valueVarObj);
Tcl_IncrRefCount(scriptObj);
- /*
- * Stop the value from getting hit in any way by any traces on the key
- * variable.
- */
-
- Tcl_IncrRefCount(valueObj);
- if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) {
- TclDecrRefCount(valueObj);
- goto error;
- }
- TclDecrRefCount(valueObj);
- if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) {
- goto error;
- }
-
- /*
- * Run the script.
- */
-
- TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj,
- valueVarObj, scriptObj);
- return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
-
- /*
- * For unwinding everything on error.
- */
-
- error:
- TclDecrRefCount(keyVarObj);
- TclDecrRefCount(valueVarObj);
- TclDecrRefCount(scriptObj);
- Tcl_DictObjDone(searchPtr);
- TclStackFree(interp, searchPtr);
- return TCL_ERROR;
-}
-
-static int
-DictForLoopCallback(
- ClientData data[],
- Tcl_Interp *interp,
- int result)
-{
- Interp *iPtr = (Interp *) interp;
- Tcl_DictSearch *searchPtr = data[0];
- Tcl_Obj *keyVarObj = data[1];
- Tcl_Obj *valueVarObj = data[2];
- Tcl_Obj *scriptObj = data[3];
- Tcl_Obj *keyObj, *valueObj;
- int done;
-
- /*
- * Process the result from the previous execution of the script body.
- */
+ result = TCL_OK;
+ while (!done) {
+ /*
+ * Stop the value from getting hit in any way by any traces on the key
+ * variable.
+ */
- if (result == TCL_CONTINUE) {
- result = TCL_OK;
- } else if (result != TCL_OK) {
- if (result == TCL_BREAK) {
+ Tcl_IncrRefCount(valueObj);
+ if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, 0) == NULL) {
Tcl_ResetResult(interp);
- result = TCL_OK;
- } else if (result == TCL_ERROR) {
- Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (\"dict for\" body line %d)",
- Tcl_GetErrorLine(interp)));
+ Tcl_AppendResult(interp, "couldn't set key variable: \"",
+ TclGetString(keyVarObj), "\"", NULL);
+ TclDecrRefCount(valueObj);
+ result = TCL_ERROR;
+ break;
}
- goto done;
- }
-
- /*
- * Get the next mapping from the dictionary.
- */
-
- Tcl_DictObjNext(searchPtr, &keyObj, &valueObj, &done);
- if (done) {
- Tcl_ResetResult(interp);
- goto done;
- }
-
- /*
- * Stop the value from getting hit in any way by any traces on the key
- * variable.
- */
-
- Tcl_IncrRefCount(valueObj);
- if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,
- TCL_LEAVE_ERR_MSG) == NULL) {
TclDecrRefCount(valueObj);
- result = TCL_ERROR;
- goto done;
- }
- TclDecrRefCount(valueObj);
- if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,
- TCL_LEAVE_ERR_MSG) == NULL) {
- result = TCL_ERROR;
- goto done;
- }
-
- /*
- * Run the script.
- */
-
- TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj,
- valueVarObj, scriptObj);
- return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
-
- /*
- * For unwinding everything once the iterating is done.
- */
-
- done:
- TclDecrRefCount(keyVarObj);
- TclDecrRefCount(valueVarObj);
- TclDecrRefCount(scriptObj);
- Tcl_DictObjDone(searchPtr);
- TclStackFree(interp, searchPtr);
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DictMapNRCmd --
- *
- * These functions implement the "dict map" Tcl command. See the user
- * documentation for details on what it does, and TIP#405 for the formal
- * specification.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-DictMapNRCmd(
- ClientData dummy,
- Tcl_Interp *interp,
- size_t objc,
- Tcl_Obj *const *objv)
-{
- Interp *iPtr = (Interp *) interp;
- Tcl_Obj **varv, *keyObj, *valueObj;
- DictMapStorage *storagePtr;
- size_t varc;
- int done;
-
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 1, objv,
- "{keyVar valueVar} dictionary script");
- return TCL_ERROR;
- }
-
- /*
- * Parse arguments.
- */
+ if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, 0) == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't set value variable: \"",
+ TclGetString(valueVarObj), "\"", NULL);
+ result = TCL_ERROR;
+ break;
+ }
- if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
- return TCL_ERROR;
- }
- if (varc != 2) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "must have exactly two variable names", TCL_STRLEN));
- return TCL_ERROR;
- }
- storagePtr = TclStackAlloc(interp, sizeof(DictMapStorage));
- if (Tcl_DictObjFirst(interp, objv[2], &storagePtr->search, &keyObj,
- &valueObj, &done) != TCL_OK) {
- TclStackFree(interp, storagePtr);
- return TCL_ERROR;
- }
- if (done) {
/*
- * Note that this exit leaves an empty value in the result (due to
- * command calling conventions) but that is OK since an empty value is
- * an empty dictionary.
+ * TIP #280. Make invoking context available to loop body.
*/
- TclStackFree(interp, storagePtr);
- return TCL_OK;
- }
- TclNewObj(storagePtr->accumulatorObj);
- TclListObjGetElements(NULL, objv[1], &varc, &varv);
- storagePtr->keyVarObj = varv[0];
- storagePtr->valueVarObj = varv[1];
- storagePtr->scriptObj = objv[3];
-
- /*
- * Make sure that these objects (which we need throughout the body of the
- * loop) don't vanish. Note that the dictionary internal rep is locked
- * internally so that updates, shimmering, etc are not a problem.
- */
-
- Tcl_IncrRefCount(storagePtr->accumulatorObj);
- Tcl_IncrRefCount(storagePtr->keyVarObj);
- Tcl_IncrRefCount(storagePtr->valueVarObj);
- Tcl_IncrRefCount(storagePtr->scriptObj);
-
- /*
- * Stop the value from getting hit in any way by any traces on the key
- * variable.
- */
-
- Tcl_IncrRefCount(valueObj);
- if (Tcl_ObjSetVar2(interp, storagePtr->keyVarObj, NULL, keyObj,
- TCL_LEAVE_ERR_MSG) == NULL) {
- TclDecrRefCount(valueObj);
- goto error;
- }
- if (Tcl_ObjSetVar2(interp, storagePtr->valueVarObj, NULL, valueObj,
- TCL_LEAVE_ERR_MSG) == NULL) {
- TclDecrRefCount(valueObj);
- goto error;
- }
- TclDecrRefCount(valueObj);
-
- /*
- * Run the script.
- */
-
- TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL);
- return TclNREvalObjEx(interp, storagePtr->scriptObj, 0,
- iPtr->cmdFramePtr, 3);
-
- /*
- * For unwinding everything on error.
- */
-
- error:
- TclDecrRefCount(storagePtr->keyVarObj);
- TclDecrRefCount(storagePtr->valueVarObj);
- TclDecrRefCount(storagePtr->scriptObj);
- TclDecrRefCount(storagePtr->accumulatorObj);
- Tcl_DictObjDone(&storagePtr->search);
- TclStackFree(interp, storagePtr);
- return TCL_ERROR;
-}
-
-static int
-DictMapLoopCallback(
- ClientData data[],
- Tcl_Interp *interp,
- int result)
-{
- Interp *iPtr = (Interp *) interp;
- DictMapStorage *storagePtr = data[0];
- Tcl_Obj *keyObj, *valueObj;
- int done;
-
- /*
- * Process the result from the previous execution of the script body.
- */
-
- if (result == TCL_CONTINUE) {
- result = TCL_OK;
- } else if (result != TCL_OK) {
- if (result == TCL_BREAK) {
- Tcl_ResetResult(interp);
+ result = TclEvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
+ if (result == TCL_CONTINUE) {
result = TCL_OK;
- } else if (result == TCL_ERROR) {
- Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (\"dict map\" body line %d)",
- Tcl_GetErrorLine(interp)));
- }
- goto done;
- } else {
- keyObj = Tcl_ObjGetVar2(interp, storagePtr->keyVarObj, NULL,
- TCL_LEAVE_ERR_MSG);
- if (keyObj == NULL) {
- result = TCL_ERROR;
- goto done;
+ } else if (result != TCL_OK) {
+ if (result == TCL_BREAK) {
+ result = TCL_OK;
+ } else if (result == TCL_ERROR) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (\"dict for\" body line %d)",
+ interp->errorLine));
+ }
+ break;
}
- Tcl_DictObjPut(NULL, storagePtr->accumulatorObj, keyObj,
- Tcl_GetObjResult(interp));
- }
-
- /*
- * Get the next mapping from the dictionary.
- */
- Tcl_DictObjNext(&storagePtr->search, &keyObj, &valueObj, &done);
- if (done) {
- Tcl_SetObjResult(interp, storagePtr->accumulatorObj);
- goto done;
+ Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
}
/*
- * Stop the value from getting hit in any way by any traces on the key
- * variable.
+ * Stop holding a reference to these objects.
*/
- Tcl_IncrRefCount(valueObj);
- if (Tcl_ObjSetVar2(interp, storagePtr->keyVarObj, NULL, keyObj,
- TCL_LEAVE_ERR_MSG) == NULL) {
- TclDecrRefCount(valueObj);
- result = TCL_ERROR;
- goto done;
- }
- if (Tcl_ObjSetVar2(interp, storagePtr->valueVarObj, NULL, valueObj,
- TCL_LEAVE_ERR_MSG) == NULL) {
- TclDecrRefCount(valueObj);
- result = TCL_ERROR;
- goto done;
- }
- TclDecrRefCount(valueObj);
-
- /*
- * Run the script.
- */
-
- TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL);
- return TclNREvalObjEx(interp, storagePtr->scriptObj, 0,
- iPtr->cmdFramePtr, 3);
-
- /*
- * For unwinding everything once the iterating is done.
- */
+ TclDecrRefCount(keyVarObj);
+ TclDecrRefCount(valueVarObj);
+ TclDecrRefCount(scriptObj);
- done:
- TclDecrRefCount(storagePtr->keyVarObj);
- TclDecrRefCount(storagePtr->valueVarObj);
- TclDecrRefCount(storagePtr->scriptObj);
- TclDecrRefCount(storagePtr->accumulatorObj);
- Tcl_DictObjDone(&storagePtr->search);
- TclStackFree(interp, storagePtr);
+ Tcl_DictObjDone(&search);
+ if (result == TCL_OK) {
+ Tcl_ResetResult(interp);
+ }
return result;
}
@@ -2762,7 +2463,7 @@ static int
DictSetCmd(
ClientData dummy,
Tcl_Interp *interp,
- size_t objc,
+ int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *resultPtr;
@@ -2822,7 +2523,7 @@ static int
DictUnsetCmd(
ClientData dummy,
Tcl_Interp *interp,
- size_t objc,
+ int objc,
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *resultPtr;
@@ -2881,25 +2582,24 @@ static int
DictFilterCmd(
ClientData dummy,
Tcl_Interp *interp,
- size_t objc,
+ int objc,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
- static const char *const filters[] = {
+ static const char *filters[] = {
"key", "script", "value", NULL
};
enum FilterTypes {
FILTER_KEYS, FILTER_SCRIPT, FILTER_VALUES
};
Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
- Tcl_Obj **varv, *keyObj = NULL, *valueObj = NULL, *resultObj, *boolObj;
+ Tcl_Obj **varv, *keyObj, *valueObj, *resultObj, *boolObj;
Tcl_DictSearch search;
- int index, done, result, satisfied;
- const char *pattern;
- size_t varc;
+ int index, varc, done, result, satisfied;
+ char *pattern;
if (objc < 3) {
- Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ?arg ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ...");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[2], filters, "filterType",
@@ -2909,6 +2609,11 @@ DictFilterCmd(
switch ((enum FilterTypes) index) {
case FILTER_KEYS:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "dictionary key globPattern");
+ return TCL_ERROR;
+ }
+
/*
* Create a dictionary whose keys all match a certain pattern.
*/
@@ -2917,52 +2622,23 @@ DictFilterCmd(
&keyObj, &valueObj, &done) != TCL_OK) {
return TCL_ERROR;
}
- if (objc == 3) {
+ pattern = TclGetString(objv[3]);
+ resultObj = Tcl_NewDictObj();
+ if (TclMatchIsTrivial(pattern)) {
/*
- * Nothing to match, so return nothing (== empty dictionary).
+ * Must release the search lock here to prevent a memory leak
+ * since we are not exhausing the search. [Bug 1705778, leak K05]
*/
Tcl_DictObjDone(&search);
- return TCL_OK;
- } else if (objc == 4) {
- pattern = TclGetString(objv[3]);
- resultObj = Tcl_NewDictObj();
- if (TclMatchIsTrivial(pattern)) {
- /*
- * Must release the search lock here to prevent a memory leak
- * since we are not exhausing the search. [Bug 1705778, leak
- * K05]
- */
-
- Tcl_DictObjDone(&search);
- Tcl_DictObjGet(interp, objv[1], objv[3], &valueObj);
- if (valueObj != NULL) {
- Tcl_DictObjPut(interp, resultObj, objv[3], valueObj);
- }
- } else {
- while (!done) {
- if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
- Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
- }
- Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
- }
+ Tcl_DictObjGet(interp, objv[1], objv[3], &valueObj);
+ if (valueObj != NULL) {
+ Tcl_DictObjPut(interp, resultObj, objv[3], valueObj);
}
} else {
- /*
- * Can't optimize this match for trivial globbing: would disturb
- * order.
- */
-
- resultObj = Tcl_NewDictObj();
while (!done) {
- int i;
-
- for (i=3 ; i<objc ; i++) {
- pattern = TclGetString(objv[i]);
- if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
- Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
- break; /* stop inner loop */
- }
+ if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
+ Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
}
Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
}
@@ -2971,6 +2647,11 @@ DictFilterCmd(
return TCL_OK;
case FILTER_VALUES:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "dictionary value globPattern");
+ return TCL_ERROR;
+ }
+
/*
* Create a dictionary whose values all match a certain pattern.
*/
@@ -2979,16 +2660,11 @@ DictFilterCmd(
&keyObj, &valueObj, &done) != TCL_OK) {
return TCL_ERROR;
}
+ pattern = TclGetString(objv[3]);
resultObj = Tcl_NewDictObj();
while (!done) {
- int i;
-
- for (i=3 ; i<objc ; i++) {
- pattern = TclGetString(objv[i]);
- if (Tcl_StringMatch(TclGetString(valueObj), pattern)) {
- Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
- break; /* stop inner loop */
- }
+ if (Tcl_StringMatch(TclGetString(valueObj), pattern)) {
+ Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
}
Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
}
@@ -3012,8 +2688,8 @@ DictFilterCmd(
return TCL_ERROR;
}
if (varc != 2) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "must have exactly two variable names", TCL_STRLEN));
+ Tcl_SetResult(interp, "must have exactly two variable names",
+ TCL_STATIC);
return TCL_ERROR;
}
keyVarObj = varv[0];
@@ -3053,19 +2729,16 @@ DictFilterCmd(
if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,
TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_ResetResult(interp);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't set key variable: \"%s\"",
- TclGetString(keyVarObj)));
+ Tcl_AppendResult(interp, "couldn't set key variable: \"",
+ TclGetString(keyVarObj), "\"", NULL);
result = TCL_ERROR;
goto abnormalResult;
}
if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,
TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_ResetResult(interp);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't set value variable: \"%s\"",
- TclGetString(valueVarObj)));
- result = TCL_ERROR;
+ Tcl_AppendResult(interp, "couldn't set value variable: \"",
+ TclGetString(valueVarObj), "\"", NULL);
goto abnormalResult;
}
@@ -3105,7 +2778,7 @@ DictFilterCmd(
case TCL_ERROR:
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (\"dict filter\" script line %d)",
- Tcl_GetErrorLine(interp)));
+ interp->errorLine));
default:
goto abnormalResult;
}
@@ -3169,13 +2842,13 @@ static int
DictUpdateCmd(
ClientData clientData,
Tcl_Interp *interp,
- size_t objc,
+ int objc,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *dictPtr, *objPtr;
- int i;
- size_t dummy;
+ int i, result, dummy;
+ Tcl_InterpState state;
if (objc < 5 || !(objc & 1)) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -3208,35 +2881,10 @@ DictUpdateCmd(
TclDecrRefCount(dictPtr);
/*
- * Execute the body after setting up the NRE handler to process the
- * results.
- */
-
- objPtr = Tcl_NewListObj(objc-3, objv+2);
- Tcl_IncrRefCount(objPtr);
- Tcl_IncrRefCount(objv[1]);
- TclNRAddCallback(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;
- size_t objc;
- Tcl_Obj *varName = data[0];
- Tcl_Obj *argsObj = data[1];
-
- /*
- * ErrorInfo handling.
+ * Execute the body.
*/
+ result = TclEvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
if (result == TCL_ERROR) {
Tcl_AddErrorInfo(interp, "\n (body of \"dict update\")");
}
@@ -3245,10 +2893,8 @@ FinalizeDictUpdate(
* If the dictionary variable doesn't exist, drop everything silently.
*/
- dictPtr = Tcl_ObjGetVar2(interp, varName, NULL, 0);
+ dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
if (dictPtr == NULL) {
- TclDecrRefCount(varName);
- TclDecrRefCount(argsObj);
return result;
}
@@ -3257,10 +2903,8 @@ FinalizeDictUpdate(
*/
state = Tcl_SaveInterpState(interp, result);
- if (Tcl_DictObjSize(interp, dictPtr, &objc) != TCL_OK) {
+ if (Tcl_DictObjSize(interp, dictPtr, &dummy) != TCL_OK) {
Tcl_DiscardInterpState(state);
- TclDecrRefCount(varName);
- TclDecrRefCount(argsObj);
return TCL_ERROR;
}
@@ -3273,8 +2917,7 @@ FinalizeDictUpdate(
* an instruction to remove the key.
*/
- Tcl_ListObjGetElements(NULL, argsObj, &objc, &objv);
- for (i=0 ; i<objc ; i+=2) {
+ for (i=2 ; i+2<objc ; i+=2) {
objPtr = Tcl_ObjGetVar2(interp, objv[i+1], NULL, 0);
if (objPtr == NULL) {
Tcl_DictObjRemove(interp, dictPtr, objv[i]);
@@ -3291,20 +2934,17 @@ FinalizeDictUpdate(
Tcl_DictObjPut(interp, dictPtr, objv[i], objPtr);
}
}
- TclDecrRefCount(argsObj);
/*
* Write the dictionary back to its variable.
*/
- if (Tcl_ObjSetVar2(interp, varName, NULL, dictPtr,
+ if (Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_DiscardInterpState(state);
- TclDecrRefCount(varName);
return TCL_ERROR;
}
- TclDecrRefCount(varName);
return Tcl_RestoreInterpState(interp, state);
}
@@ -3330,11 +2970,14 @@ static int
DictWithCmd(
ClientData dummy,
Tcl_Interp *interp,
- size_t objc,
+ int objc,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
- Tcl_Obj *dictPtr, *keysPtr, *pathPtr;
+ Tcl_Obj *dictPtr, *keysPtr, *keyPtr, *valPtr, **keyv, *leafPtr;
+ Tcl_DictSearch s;
+ Tcl_InterpState state;
+ int done, result, keyc, i, allocdict = 0;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "dictVar ?key ...? script");
@@ -3349,126 +2992,11 @@ DictWithCmd(
if (dictPtr == NULL) {
return TCL_ERROR;
}
-
- keysPtr = TclDictWithInit(interp, dictPtr, objc-3, objv+2);
- if (keysPtr == NULL) {
- return TCL_ERROR;
- }
- Tcl_IncrRefCount(keysPtr);
-
- /*
- * Execute the body, while making the invoking context available to the
- * loop body (TIP#280) and postponing the cleanup until later (NRE).
- */
-
- pathPtr = NULL;
if (objc > 3) {
- pathPtr = Tcl_NewListObj(objc-3, objv+2);
- Tcl_IncrRefCount(pathPtr);
- }
- Tcl_IncrRefCount(objv[1]);
- TclNRAddCallback(interp, FinalizeDictWith, objv[1], keysPtr, pathPtr,
- NULL);
-
- return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
-}
-
-static int
-FinalizeDictWith(
- ClientData data[],
- Tcl_Interp *interp,
- int result)
-{
- Tcl_Obj **pathv;
- size_t pathc;
- Tcl_InterpState state;
- Tcl_Obj *varName = data[0];
- Tcl_Obj *keysPtr = data[1];
- Tcl_Obj *pathPtr = data[2];
- Var *varPtr, *arrayPtr;
-
- if (result == TCL_ERROR) {
- Tcl_AddErrorInfo(interp, "\n (body of \"dict with\")");
- }
-
- /*
- * Save the result state; TDWF doesn't guarantee to not modify that on
- * TCL_OK result.
- */
-
- state = Tcl_SaveInterpState(interp, result);
- if (pathPtr != NULL) {
- Tcl_ListObjGetElements(NULL, pathPtr, &pathc, &pathv);
- } else {
- pathc = 0;
- pathv = NULL;
- }
-
- /*
- * Pack from local variables back into the dictionary.
- */
-
- varPtr = TclObjLookupVarEx(interp, varName, NULL, TCL_LEAVE_ERR_MSG, "set",
- /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
- if (varPtr == NULL) {
- result = TCL_ERROR;
- } else {
- result = TclDictWithFinish(interp, varPtr, arrayPtr, varName, NULL, -1,
- pathc, pathv, keysPtr);
- }
-
- /*
- * Tidy up and return the real result (unless we had an error).
- */
-
- TclDecrRefCount(varName);
- TclDecrRefCount(keysPtr);
- if (pathPtr != NULL) {
- TclDecrRefCount(pathPtr);
- }
- if (result != TCL_OK) {
- Tcl_DiscardInterpState(state);
- return TCL_ERROR;
- }
- return Tcl_RestoreInterpState(interp, state);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclDictWithInit --
- *
- * Part of the core of [dict with]. Pokes into a dictionary and converts
- * the mappings there into assignments to (presumably) local variables.
- * Returns a list of all the names that were mapped so that removal of
- * either the variable or the dictionary entry won't surprise us when we
- * come to stuffing everything back.
- *
- * Result:
- * List of mapped names, or NULL if there was an error.
- *
- * Side effects:
- * Assigns to variables, so potentially legion due to traces.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclDictWithInit(
- Tcl_Interp *interp,
- Tcl_Obj *dictPtr,
- size_t pathc,
- Tcl_Obj *const pathv[])
-{
- Tcl_DictSearch s;
- Tcl_Obj *keyPtr, *valPtr, *keysPtr;
- int done;
-
- if (pathc > 0) {
- dictPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv,
+ dictPtr = TclTraceDictPath(interp, dictPtr, objc-3, objv+2,
DICT_PATH_READ);
if (dictPtr == NULL) {
- return NULL;
+ return TCL_ERROR;
}
}
@@ -3481,10 +3009,11 @@ TclDictWithInit(
if (Tcl_DictObjFirst(interp, dictPtr, &s, &keyPtr, &valPtr,
&done) != TCL_OK) {
- return NULL;
+ return TCL_ERROR;
}
TclNewObj(keysPtr);
+ Tcl_IncrRefCount(keysPtr);
for (; !done ; Tcl_DictObjNext(&s, &keyPtr, &valPtr, &done)) {
Tcl_ListObjAppendElement(NULL, keysPtr, keyPtr);
@@ -3492,88 +3021,47 @@ TclDictWithInit(
TCL_LEAVE_ERR_MSG) == NULL) {
TclDecrRefCount(keysPtr);
Tcl_DictObjDone(&s);
- return NULL;
+ return TCL_ERROR;
}
}
- return keysPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclDictWithFinish --
- *
- * Part of the core of [dict with]. Reassembles the piece of the dict (in
- * varName, location given by pathc/pathv) from the variables named in
- * the keysPtr argument. NB, does not try to preserve errors or manage
- * argument lifetimes.
- *
- * Result:
- * TCL_OK if we succeeded, or TCL_ERROR if we failed.
- *
- * Side effects:
- * Assigns to a variable, so potentially legion due to traces. Updates
- * the dictionary in the named variable.
- *
- *----------------------------------------------------------------------
- */
+ /*
+ * Execute the body, while making the invoking context available to the
+ * loop body (TIP#280).
+ */
-int
-TclDictWithFinish(
- Tcl_Interp *interp, /* Command interpreter in which variable
- * exists. Used for state management, traces
- * and error reporting. */
- Var *varPtr, /* Reference to the variable holding the
- * dictionary. */
- Var *arrayPtr, /* Reference to the array containing the
- * variable, or NULL if the variable is a
- * scalar. */
- Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or
- * the name of a variable. NULL if the 'index'
- * parameter is >= 0 */
- Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element
- * in the array part1. */
- int index, /* Index into the local variable table of the
- * variable, or -1. Only used when part1Ptr is
- * NULL. */
- size_t pathc, /* The number of elements in the path into the
- * dictionary. */
- Tcl_Obj *const pathv[], /* The elements of the path to the subdict. */
- Tcl_Obj *keysPtr) /* List of keys to be synchronized. This is
- * the result value from TclDictWithInit. */
-{
- Tcl_Obj *dictPtr, *leafPtr, *valPtr;
- size_t i, keyc;
- Tcl_Obj **keyv;
- int allocdict;
+ result = TclEvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
+ if (result == TCL_ERROR) {
+ Tcl_AddErrorInfo(interp, "\n (body of \"dict with\")");
+ }
/*
* If the dictionary variable doesn't exist, drop everything silently.
*/
- dictPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
- TCL_LEAVE_ERR_MSG, index);
+ dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
if (dictPtr == NULL) {
- return TCL_OK;
+ TclDecrRefCount(keysPtr);
+ return result;
}
/*
* Double-check that it is still a dictionary.
*/
+ state = Tcl_SaveInterpState(interp, result);
if (Tcl_DictObjSize(interp, dictPtr, &i) != TCL_OK) {
+ TclDecrRefCount(keysPtr);
+ Tcl_DiscardInterpState(state);
return TCL_ERROR;
}
if (Tcl_IsShared(dictPtr)) {
dictPtr = Tcl_DuplicateObj(dictPtr);
allocdict = 1;
- } else {
- allocdict = 0;
}
- if (pathc > 0) {
+ if (objc > 3) {
/*
* Want to get to the dictionary which we will update; need to do
* prepare-for-update de-sharing along the path *but* avoid generating
@@ -3583,19 +3071,22 @@ TclDictWithFinish(
* perfectly efficient (but no memory should be leaked).
*/
- leafPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv,
+ leafPtr = TclTraceDictPath(interp, dictPtr, objc-3, objv+2,
DICT_PATH_EXISTS | DICT_PATH_UPDATE);
if (leafPtr == NULL) {
+ TclDecrRefCount(keysPtr);
if (allocdict) {
TclDecrRefCount(dictPtr);
}
+ Tcl_DiscardInterpState(state);
return TCL_ERROR;
}
if (leafPtr == DICT_PATH_NON_EXISTENT) {
+ TclDecrRefCount(keysPtr);
if (allocdict) {
TclDecrRefCount(dictPtr);
}
- return TCL_OK;
+ return Tcl_RestoreInterpState(interp, state);
}
} else {
leafPtr = dictPtr;
@@ -3621,13 +3112,14 @@ TclDictWithFinish(
Tcl_DictObjPut(NULL, leafPtr, keyv[i], valPtr);
}
}
+ TclDecrRefCount(keysPtr);
/*
* Ensure that none of the dictionaries in the chain still have a string
* rep.
*/
- if (pathc > 0) {
+ if (objc > 3) {
InvalidateDictChain(leafPtr);
}
@@ -3635,14 +3127,12 @@ TclDictWithFinish(
* Write back the outermost dictionary to the variable.
*/
- if (TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, dictPtr,
- TCL_LEAVE_ERR_MSG, index) == NULL) {
- if (allocdict) {
- TclDecrRefCount(dictPtr);
- }
+ if (Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ Tcl_DiscardInterpState(state);
return TCL_ERROR;
}
- return TCL_OK;
+ return Tcl_RestoreInterpState(interp, state);
}
/*
generated by cgit v0.12 at 2025-12-18 18:31:09 (GMT)