summaryrefslogtreecommitdiffstats
path: root/generic/tclDictObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclDictObj.c')
-rw-r--r--generic/tclDictObj.c569
1 files changed, 197 insertions, 372 deletions
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 83fc3a6..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.
@@ -31,6 +31,8 @@ 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,
@@ -70,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 DictForNRCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *const *objv);
-static int DictForLoopCallback(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, NULL, NULL, NULL, 0 },
- {"exists", DictExistsCmd, NULL, 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 },
- {"merge", DictMergeCmd, NULL, 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, NULL, NULL, NULL, 0 },
- {"update", DictUpdateCmd, TclCompileDictUpdateCmd, NULL, NULL, 0 },
- {"values", DictValuesCmd, NULL, NULL, NULL, 0 },
- {"with", DictWithCmd, NULL, 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}
};
/*
@@ -155,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 */
};
@@ -173,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,
@@ -210,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;
@@ -257,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.
@@ -285,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;
@@ -340,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;
/*
@@ -350,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);
@@ -359,7 +352,7 @@ DupDictInternalRep(
* Fill in the contents.
*/
- Tcl_SetHashValue(hPtr, valuePtr);
+ Tcl_SetHashValue(hPtr, (ClientData) valuePtr);
Tcl_IncrRefCount(valuePtr);
}
@@ -375,7 +368,7 @@ DupDictInternalRep(
* Store in the object.
*/
- copyPtr->internalRep.otherValuePtr = newDict;
+ copyPtr->internalRep.twoPtrValue.ptr1 = newDict;
copyPtr->typePtr = &tclDictType;
}
@@ -401,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;
}
@@ -437,7 +428,7 @@ DeleteDict(
Dict *dict)
{
DeleteChainTable(dict);
- ckfree(dict);
+ ckfree((char *) dict);
}
/*
@@ -468,12 +459,11 @@ 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, length, bytesNeeded = 0;
- const char *elem;
- char *dst;
+ char *elem, *dst;
const int maxFlags = UINT_MAX / sizeof(int);
/*
@@ -499,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) {
/*
@@ -508,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) {
@@ -533,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++ = ' ';
@@ -551,7 +541,7 @@ UpdateStringOfDict(
dictPtr->bytes[dictPtr->length] = '\0';
if (flagPtr != localFlags) {
- ckfree(flagPtr);
+ ckfree((char *) flagPtr);
}
}
@@ -582,7 +572,7 @@ SetDictFromAny(
{
Tcl_HashEntry *hPtr;
int isNew, result;
- Dict *dict = ckalloc(sizeof(Dict));
+ Dict *dict = (Dict *) ckalloc(sizeof(Dict));
InitChainTable(dict);
@@ -603,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) {
@@ -694,23 +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_SetResult(interp, "missing value to go with key", TCL_STATIC);
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
}
result = TCL_ERROR;
errorExit:
- if (interp != NULL) {
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
- }
DeleteChainTable(dict);
- ckfree(dict);
+ ckfree((char *) dict);
return result;
}
@@ -762,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) {
@@ -805,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;
@@ -848,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);
}
@@ -905,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) {
@@ -953,12 +939,13 @@ Tcl_DictObjGet(
if (dictPtr->typePtr != &tclDictType) {
int result = SetDictFromAny(interp, dictPtr);
if (result != TCL_OK) {
+ *valuePtrPtr = NULL;
return result;
}
}
- 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 {
@@ -1006,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++;
}
@@ -1048,7 +1035,7 @@ Tcl_DictObjSize(
}
}
- dict = dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
*sizePtr = dict->table.numEntries;
return TCL_OK;
}
@@ -1103,7 +1090,7 @@ Tcl_DictObjFirst(
}
}
- dict = dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
cPtr = dict->entryChainHead;
if (cPtr == NULL) {
searchPtr->epoch = -1;
@@ -1115,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);
@@ -1191,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) {
@@ -1278,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) {
@@ -1334,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;
@@ -1374,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
@@ -1423,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 */
@@ -1518,7 +1506,7 @@ DictGetCmd(
int result;
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key key ...?");
return TCL_ERROR;
}
@@ -1529,7 +1517,7 @@ DictGetCmd(
*/
if (objc == 2) {
- Tcl_Obj *keyPtr = NULL, *listPtr;
+ Tcl_Obj *keyPtr, *listPtr;
Tcl_DictSearch search;
int done;
@@ -1574,8 +1562,6 @@ DictGetCmd(
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "key \"", TclGetString(objv[objc-1]),
"\" not known in dictionary", NULL);
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
- TclGetString(objv[objc-1]), NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, valuePtr);
@@ -1711,7 +1697,7 @@ DictMergeCmd(
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;
@@ -1801,7 +1787,7 @@ DictKeysCmd(
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?");
@@ -1835,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
@@ -1883,10 +1869,10 @@ DictValuesCmd(
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?");
@@ -1982,7 +1968,6 @@ DictExistsCmd(
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr;
- int result;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "dictionary key ?key ...?");
@@ -1991,18 +1976,13 @@ DictExistsCmd(
dictPtr = TclTraceDictPath(interp, objv[1], objc-3, objv+2,
DICT_PATH_EXISTS);
- if (dictPtr == NULL) {
- return TCL_ERROR;
- }
- if (dictPtr == DICT_PATH_NON_EXISTENT) {
+ if (dictPtr == NULL || dictPtr == DICT_PATH_NON_EXISTENT
+ || Tcl_DictObjGet(interp, dictPtr, objv[objc-1],
+ &valuePtr) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
- return TCL_OK;
- }
- result = Tcl_DictObjGet(interp, dictPtr, objv[objc-1], &valuePtr);
- if (result != TCL_OK) {
- return result;
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(valuePtr != NULL));
}
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(valuePtr != NULL));
return TCL_OK;
}
@@ -2046,9 +2026,13 @@ DictInfoCmd(
return result;
}
}
- dict = dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.twoPtrValue.ptr1;
- Tcl_SetResult(interp, Tcl_HashStats(&dict->table), TCL_DYNAMIC);
+ /*
+ * This next cast is actually OK.
+ */
+
+ Tcl_SetResult(interp, (char *) Tcl_HashStats(&dict->table), TCL_DYNAMIC);
return TCL_OK;
}
@@ -2159,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) {
@@ -2248,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,
@@ -2335,7 +2319,7 @@ DictAppendCmd(
/*
*----------------------------------------------------------------------
*
- * DictForNRCmd --
+ * DictForCmd --
*
* This function implements the "dict for" Tcl command. See the user
* documentation for details on what it does, and TIP#111 for the formal
@@ -2351,7 +2335,7 @@ DictAppendCmd(
*/
static int
-DictForNRCmd(
+DictForCmd(
ClientData dummy,
Tcl_Interp *interp,
int objc,
@@ -2360,8 +2344,8 @@ DictForNRCmd(
Interp *iPtr = (Interp *) interp;
Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
Tcl_Obj **varv, *keyObj, *valueObj;
- Tcl_DictSearch *searchPtr;
- int varc, done;
+ Tcl_DictSearch search;
+ int varc, done, result;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -2369,10 +2353,6 @@ DictForNRCmd(
return TCL_ERROR;
}
- /*
- * Parse arguments.
- */
-
if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
return TCL_ERROR;
}
@@ -2381,21 +2361,15 @@ DictForNRCmd(
TCL_STATIC);
return TCL_ERROR;
}
- searchPtr = TclStackAlloc(interp, sizeof(Tcl_DictSearch));
- if (Tcl_DictObjFirst(interp, objv[2], searchPtr, &keyObj, &valueObj,
- &done) != TCL_OK) {
- TclStackFree(interp, searchPtr);
- 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
@@ -2406,119 +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.
- */
+ result = TCL_OK;
+ while (!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) {
+ Tcl_IncrRefCount(valueObj);
+ if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, 0) == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't set key variable: \"",
+ TclGetString(keyVarObj), "\"", NULL);
+ TclDecrRefCount(valueObj);
+ result = TCL_ERROR;
+ break;
+ }
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.
- */
-
- if (result == TCL_CONTINUE) {
- result = TCL_OK;
- } else if (result != TCL_OK) {
- if (result == TCL_BREAK) {
+ if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, 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 value variable: \"",
+ TclGetString(valueVarObj), "\"", NULL);
+ 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;
- }
+ /*
+ * TIP #280. Make invoking context available to loop body.
+ */
- /*
- * Stop the value from getting hit in any way by any traces on the key
- * variable.
- */
+ result = TclEvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
+ if (result == TCL_CONTINUE) {
+ result = TCL_OK;
+ } 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_IncrRefCount(valueObj);
- if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) {
- TclDecrRefCount(valueObj);
- result = TCL_ERROR;
- goto done;
+ Tcl_DictObjNext(&search, &keyObj, &valueObj, &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.
+ * Stop holding a reference to these objects.
*/
- done:
TclDecrRefCount(keyVarObj);
TclDecrRefCount(valueVarObj);
TclDecrRefCount(scriptObj);
- Tcl_DictObjDone(searchPtr);
- TclStackFree(interp, searchPtr);
+
+ Tcl_DictObjDone(&search);
+ if (result == TCL_OK) {
+ Tcl_ResetResult(interp);
+ }
return result;
}
@@ -2667,20 +2586,20 @@ DictFilterCmd(
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, varc, done, result, satisfied;
- const char *pattern;
+ 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",
@@ -2690,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.
*/
@@ -2698,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);
}
@@ -2752,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.
*/
@@ -2760,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);
}
@@ -2883,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;
}
@@ -2952,7 +2847,8 @@ DictUpdateCmd(
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *dictPtr, *objPtr;
- int i, dummy;
+ int i, result, dummy;
+ Tcl_InterpState state;
if (objc < 5 || !(objc & 1)) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -2985,34 +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, 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\")");
}
@@ -3021,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;
}
@@ -3033,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;
}
@@ -3049,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]);
@@ -3067,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);
}
@@ -3110,9 +2974,10 @@ DictWithCmd(
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
- Tcl_Obj *dictPtr, *keysPtr, *keyPtr = NULL, *valPtr = NULL, *pathPtr;
+ Tcl_Obj *dictPtr, *keysPtr, *keyPtr, *valPtr, **keyv, *leafPtr;
Tcl_DictSearch s;
- int done;
+ Tcl_InterpState state;
+ int done, result, keyc, i, allocdict = 0;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "dictVar ?key ...? script");
@@ -3162,34 +3027,10 @@ DictWithCmd(
/*
* Execute the body, while making the invoking context available to the
- * loop body (TIP#280) and postponing the cleanup until later (NRE).
+ * loop body (TIP#280).
*/
- 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 **keyv, *leafPtr, *dictPtr, *valPtr;
- int keyc, i, allocdict = 0;
- Tcl_InterpState state;
- Tcl_Obj *varName = data[0];
- Tcl_Obj *keysPtr = data[1];
- Tcl_Obj *pathPtr = data[2];
-
+ result = TclEvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
if (result == TCL_ERROR) {
Tcl_AddErrorInfo(interp, "\n (body of \"dict with\")");
}
@@ -3198,13 +3039,9 @@ FinalizeDictWith(
* 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(keysPtr);
- if (pathPtr) {
- TclDecrRefCount(pathPtr);
- }
return result;
}
@@ -3214,11 +3051,7 @@ FinalizeDictWith(
state = Tcl_SaveInterpState(interp, result);
if (Tcl_DictObjSize(interp, dictPtr, &i) != TCL_OK) {
- TclDecrRefCount(varName);
TclDecrRefCount(keysPtr);
- if (pathPtr) {
- TclDecrRefCount(pathPtr);
- }
Tcl_DiscardInterpState(state);
return TCL_ERROR;
}
@@ -3228,10 +3061,7 @@ FinalizeDictWith(
allocdict = 1;
}
- if (pathPtr != NULL) {
- Tcl_Obj **pathv;
- int pathc;
-
+ 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
@@ -3241,12 +3071,9 @@ FinalizeDictWith(
* perfectly efficient (but no memory should be leaked).
*/
- Tcl_ListObjGetElements(NULL, pathPtr, &pathc, &pathv);
- leafPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv,
+ leafPtr = TclTraceDictPath(interp, dictPtr, objc-3, objv+2,
DICT_PATH_EXISTS | DICT_PATH_UPDATE);
- TclDecrRefCount(pathPtr);
if (leafPtr == NULL) {
- TclDecrRefCount(varName);
TclDecrRefCount(keysPtr);
if (allocdict) {
TclDecrRefCount(dictPtr);
@@ -3255,7 +3082,6 @@ FinalizeDictWith(
return TCL_ERROR;
}
if (leafPtr == DICT_PATH_NON_EXISTENT) {
- TclDecrRefCount(varName);
TclDecrRefCount(keysPtr);
if (allocdict) {
TclDecrRefCount(dictPtr);
@@ -3293,7 +3119,7 @@ FinalizeDictWith(
* rep.
*/
- if (pathPtr != NULL) {
+ if (objc > 3) {
InvalidateDictChain(leafPtr);
}
@@ -3301,12 +3127,11 @@ FinalizeDictWith(
* Write back the outermost dictionary to the variable.
*/
- if (Tcl_ObjSetVar2(interp, varName, NULL, dictPtr,
+ if (Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_DiscardInterpState(state);
return TCL_ERROR;
}
- TclDecrRefCount(varName);
return Tcl_RestoreInterpState(interp, state);
}
@@ -3334,7 +3159,7 @@ TclInitDictCmd(
{
return TclMakeEnsemble(interp, "dict", implementationMap);
}
-
+
/*
* Local Variables:
* mode: c
generated by cgit v0.12 at 2025-12-21 01:28:08 (GMT)