diff options
Diffstat (limited to 'generic/tclDictObj.c')
-rw-r--r-- | generic/tclDictObj.c | 1173 |
1 files changed, 336 insertions, 837 deletions
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 980f0a8..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,45 +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 DictMapNRCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); -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, TclCompileBasic1ArgCmd, NULL, NULL, 0 }, - {"keys", DictKeysCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, - {"lappend", DictLappendCmd, TclCompileDictLappendCmd, NULL, NULL, 0 }, - {"map", NULL, TclCompileDictMapCmd, DictMapNRCmd, NULL, 0 }, - {"merge", DictMergeCmd, TclCompileDictMergeCmd, NULL, NULL, 0 }, - {"remove", DictRemoveCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0 }, - {"replace", DictReplaceCmd, NULL, NULL, NULL, 0 }, - {"set", DictSetCmd, TclCompileDictSetCmd, NULL, NULL, 0 }, - {"size", DictSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0 }, - {"unset", DictUnsetCmd, TclCompileDictUnsetCmd, NULL, NULL, 0 }, - {"update", DictUpdateCmd, TclCompileDictUpdateCmd, NULL, NULL, 0 }, - {"values", DictValuesCmd, TclCompileBasic1Or2ArgCmd, 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} }; /* @@ -155,21 +144,14 @@ typedef struct Dict { } Dict; /* - * Accessor macro for converting between a Tcl_Obj* and a Dict. Note that this - * must be assignable as well as readable. - */ - -#define DICT(dictObj) (*((Dict **)&(dictObj)->internalRep.twoPtrValue.ptr1)) - -/* * The structure below defines the dictionary object type by means of * 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 */ }; @@ -184,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, @@ -192,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 *****/ @@ -238,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; @@ -285,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. @@ -313,13 +278,12 @@ DeleteChainEntry( Tcl_Obj *keyPtr) { ChainEntry *cPtr = (ChainEntry *) - Tcl_FindHashEntry(&dict->table, keyPtr); + Tcl_FindHashEntry(&dict->table, (char *) keyPtr); if (cPtr == NULL) { return 0; } else { Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry); - TclDecrRefCount(valuePtr); } @@ -369,8 +333,8 @@ DupDictInternalRep( Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) { - Dict *oldDict = DICT(srcPtr); - Dict *newDict = ckalloc(sizeof(Dict)); + Dict *oldDict = srcPtr->internalRep.twoPtrValue.ptr1; + Dict *newDict = (Dict *) ckalloc(sizeof(Dict)); ChainEntry *cPtr; /* @@ -379,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); @@ -388,7 +352,7 @@ DupDictInternalRep( * Fill in the contents. */ - Tcl_SetHashValue(hPtr, valuePtr); + Tcl_SetHashValue(hPtr, (ClientData) valuePtr); Tcl_IncrRefCount(valuePtr); } @@ -404,8 +368,7 @@ DupDictInternalRep( * Store in the object. */ - DICT(copyPtr) = newDict; - copyPtr->internalRep.twoPtrValue.ptr2 = NULL; + copyPtr->internalRep.twoPtrValue.ptr1 = newDict; copyPtr->typePtr = &tclDictType; } @@ -431,9 +394,9 @@ static void FreeDictInternalRep( Tcl_Obj *dictPtr) { - Dict *dict = DICT(dictPtr); + Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1; - dict->refcount--; + --dict->refcount; if (dict->refcount <= 0) { DeleteDict(dict); } @@ -465,7 +428,7 @@ DeleteDict( Dict *dict) { DeleteChainTable(dict); - ckfree(dict); + ckfree((char *) dict); } /* @@ -496,12 +459,11 @@ UpdateStringOfDict( { #define LOCAL_SIZE 20 int localFlags[LOCAL_SIZE], *flagPtr = NULL; - Dict *dict = DICT(dictPtr); + 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); /* @@ -527,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) { /* @@ -536,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) { @@ -561,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++ = ' '; @@ -579,7 +541,7 @@ UpdateStringOfDict( dictPtr->bytes[dictPtr->length] = '\0'; if (flagPtr != localFlags) { - ckfree(flagPtr); + ckfree((char *) flagPtr); } } @@ -609,8 +571,8 @@ SetDictFromAny( Tcl_Obj *objPtr) { Tcl_HashEntry *hPtr; - int isNew; - Dict *dict = ckalloc(sizeof(Dict)); + int isNew, result; + Dict *dict = (Dict *) ckalloc(sizeof(Dict)); InitChainTable(dict); @@ -660,9 +622,10 @@ SetDictFromAny( const char *elemStart; int elemSize, literal; - if (TclFindDictElement(interp, nextElem, (limit - nextElem), - &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) { - goto errorInFindDictElement; + result = TclFindElement(interp, nextElem, (limit - nextElem), + &elemStart, &nextElem, &elemSize, &literal); + if (result != TCL_OK) { + goto errorExit; } if (elemStart == limit) { break; @@ -681,10 +644,11 @@ SetDictFromAny( keyPtr->bytes); } - if (TclFindDictElement(interp, nextElem, (limit - nextElem), - &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) { + result = TclFindElement(interp, nextElem, (limit - nextElem), + &elemStart, &nextElem, &elemSize, &literal); + if (result != TCL_OK) { TclDecrRefCount(keyPtr); - goto errorInFindDictElement; + goto errorExit; } if (literal) { @@ -720,21 +684,20 @@ SetDictFromAny( dict->epoch = 0; dict->chain = NULL; dict->refcount = 1; - DICT(objPtr) = dict; - objPtr->internalRep.twoPtrValue.ptr2 = NULL; + 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", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL); + Tcl_SetResult(interp, "missing value to go with key", TCL_STATIC); } - errorInFindDictElement: + result = TCL_ERROR; + + errorExit: DeleteChainTable(dict); - ckfree(dict); - return TCL_ERROR; + ckfree((char *) dict); + return result; } /* @@ -780,17 +743,18 @@ TclTraceDictPath( Dict *dict, *newDict; int i; - if (dictPtr->typePtr != &tclDictType - && SetDictFromAny(interp, dictPtr) != TCL_OK) { - return NULL; + if (dictPtr->typePtr != &tclDictType) { + if (SetDictFromAny(interp, dictPtr) != TCL_OK) { + return NULL; + } } - dict = DICT(dictPtr); + 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) { @@ -801,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); } @@ -820,21 +784,22 @@ TclTraceDictPath( Tcl_SetHashValue(hPtr, tmpObj); } else { tmpObj = Tcl_GetHashValue(hPtr); - if (tmpObj->typePtr != &tclDictType - && SetDictFromAny(interp, tmpObj) != TCL_OK) { - return NULL; + if (tmpObj->typePtr != &tclDictType) { + if (SetDictFromAny(interp, tmpObj) != TCL_OK) { + return NULL; + } } } - newDict = DICT(tmpObj); + 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 = DICT(tmpObj); + newDict = tmpObj->internalRep.twoPtrValue.ptr1; } newDict->chain = dictPtr; @@ -869,7 +834,7 @@ static void InvalidateDictChain( Tcl_Obj *dictObj) { - Dict *dict = DICT(dictObj); + Dict *dict = dictObj->internalRep.twoPtrValue.ptr1; do { TclInvalidateStringRep(dictObj); @@ -879,7 +844,7 @@ InvalidateDictChain( break; } dict->chain = NULL; - dict = DICT(dictObj); + dict = dictObj->internalRep.twoPtrValue.ptr1; } while (dict != NULL); } @@ -917,15 +882,18 @@ Tcl_DictObjPut( Tcl_Panic("%s called with shared object", "Tcl_DictObjPut"); } - if (dictPtr->typePtr != &tclDictType - && SetDictFromAny(interp, dictPtr) != TCL_OK) { - return TCL_ERROR; + if (dictPtr->typePtr != &tclDictType) { + int result = SetDictFromAny(interp, dictPtr); + + if (result != TCL_OK) { + return result; + } } if (dictPtr->bytes != NULL) { TclInvalidateStringRep(dictPtr); } - dict = DICT(dictPtr); + dict = dictPtr->internalRep.twoPtrValue.ptr1; hPtr = CreateChainEntry(dict, keyPtr, &isNew); Tcl_IncrRefCount(valuePtr); if (!isNew) { @@ -968,14 +936,16 @@ Tcl_DictObjGet( Dict *dict; Tcl_HashEntry *hPtr; - if (dictPtr->typePtr != &tclDictType - && SetDictFromAny(interp, dictPtr) != TCL_OK) { - *valuePtrPtr = NULL; - return TCL_ERROR; + if (dictPtr->typePtr != &tclDictType) { + int result = SetDictFromAny(interp, dictPtr); + if (result != TCL_OK) { + *valuePtrPtr = NULL; + return result; + } } - dict = DICT(dictPtr); - hPtr = Tcl_FindHashEntry(&dict->table, keyPtr); + dict = dictPtr->internalRep.twoPtrValue.ptr1; + hPtr = Tcl_FindHashEntry(&dict->table, (char *) keyPtr); if (hPtr == NULL) { *valuePtrPtr = NULL; } else { @@ -1015,16 +985,18 @@ Tcl_DictObjRemove( Tcl_Panic("%s called with shared object", "Tcl_DictObjRemove"); } - if (dictPtr->typePtr != &tclDictType - && SetDictFromAny(interp, dictPtr) != TCL_OK) { - return TCL_ERROR; + if (dictPtr->typePtr != &tclDictType) { + int result = SetDictFromAny(interp, dictPtr); + if (result != TCL_OK) { + return result; + } } - dict = DICT(dictPtr); + if (dictPtr->bytes != NULL) { + TclInvalidateStringRep(dictPtr); + } + dict = dictPtr->internalRep.twoPtrValue.ptr1; if (DeleteChainEntry(dict, keyPtr)) { - if (dictPtr->bytes != NULL) { - TclInvalidateStringRep(dictPtr); - } dict->epoch++; } return TCL_OK; @@ -1056,12 +1028,14 @@ Tcl_DictObjSize( { Dict *dict; - if (dictPtr->typePtr != &tclDictType - && SetDictFromAny(interp, dictPtr) != TCL_OK) { - return TCL_ERROR; + if (dictPtr->typePtr != &tclDictType) { + int result = SetDictFromAny(interp, dictPtr); + if (result != TCL_OK) { + return result; + } } - dict = DICT(dictPtr); + dict = dictPtr->internalRep.twoPtrValue.ptr1; *sizePtr = dict->table.numEntries; return TCL_OK; } @@ -1108,12 +1082,15 @@ Tcl_DictObjFirst( Dict *dict; ChainEntry *cPtr; - if (dictPtr->typePtr != &tclDictType - && SetDictFromAny(interp, dictPtr) != TCL_OK) { - return TCL_ERROR; + if (dictPtr->typePtr != &tclDictType) { + int result = SetDictFromAny(interp, dictPtr); + + if (result != TCL_OK) { + return result; + } } - dict = DICT(dictPtr); + dict = dictPtr->internalRep.twoPtrValue.ptr1; cPtr = dict->entryChainHead; if (cPtr == NULL) { searchPtr->epoch = -1; @@ -1125,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); @@ -1201,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) { @@ -1288,12 +1266,11 @@ Tcl_DictObjPutKeyList( return TCL_ERROR; } - dict = DICT(dictPtr); + dict = dictPtr->internalRep.twoPtrValue.ptr1; hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew); Tcl_IncrRefCount(valuePtr); if (!isNew) { Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr); - TclDecrRefCount(oldValuePtr); } Tcl_SetHashValue(hPtr, valuePtr); @@ -1345,7 +1322,7 @@ Tcl_DictObjRemoveKeyList( return TCL_ERROR; } - dict = DICT(dictPtr); + dict = dictPtr->internalRep.twoPtrValue.ptr1; DeleteChainEntry(dict, keyv[keyc-1]); InvalidateDictChain(dictPtr); return TCL_OK; @@ -1386,13 +1363,12 @@ Tcl_NewDictObj(void) TclNewObj(dictPtr); TclInvalidateStringRep(dictPtr); - dict = ckalloc(sizeof(Dict)); + dict = (Dict *) ckalloc(sizeof(Dict)); InitChainTable(dict); dict->epoch = 0; dict->chain = NULL; dict->refcount = 1; - DICT(dictPtr) = dict; - dictPtr->internalRep.twoPtrValue.ptr2 = NULL; + dictPtr->internalRep.twoPtrValue.ptr1 = dict; dictPtr->typePtr = &tclDictType; return dictPtr; #endif @@ -1436,13 +1412,12 @@ Tcl_DbNewDictObj( TclDbNewObj(dictPtr, file, line); TclInvalidateStringRep(dictPtr); - dict = ckalloc(sizeof(Dict)); + dict = (Dict *) ckalloc(sizeof(Dict)); InitChainTable(dict); dict->epoch = 0; dict->chain = NULL; dict->refcount = 1; - DICT(dictPtr) = dict; - dictPtr->internalRep.twoPtrValue.ptr2 = NULL; + dictPtr->internalRep.twoPtrValue.ptr1 = dict; dictPtr->typePtr = &tclDictType; return dictPtr; #else /* !TCL_MEM_DEBUG */ @@ -1496,7 +1471,7 @@ DictCreateCmd( /* * The next command is assumed to never fail... */ - Tcl_DictObjPut(NULL, dictObj, objv[i], objv[i+1]); + Tcl_DictObjPut(interp, dictObj, objv[i], objv[i+1]); } Tcl_SetObjResult(interp, dictObj); return TCL_OK; @@ -1531,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; } @@ -1542,7 +1517,7 @@ DictGetCmd( */ if (objc == 2) { - Tcl_Obj *keyPtr = NULL, *listPtr; + Tcl_Obj *keyPtr, *listPtr; Tcl_DictSearch search; int done; @@ -1584,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); @@ -1621,7 +1594,8 @@ DictReplaceCmd( Tcl_Obj *const *objv) { Tcl_Obj *dictPtr; - int i; + int i, result; + int allocatedDict = 0; if ((objc < 2) || (objc & 1)) { Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key value ...?"); @@ -1629,18 +1603,18 @@ DictReplaceCmd( } dictPtr = objv[1]; - if (dictPtr->typePtr != &tclDictType - && SetDictFromAny(interp, dictPtr) != TCL_OK) { - return TCL_ERROR; - } if (Tcl_IsShared(dictPtr)) { dictPtr = Tcl_DuplicateObj(dictPtr); - } - if (dictPtr->bytes != NULL) { - TclInvalidateStringRep(dictPtr); + allocatedDict = 1; } for (i=2 ; i<objc ; i+=2) { - Tcl_DictObjPut(NULL, dictPtr, objv[i], objv[i+1]); + result = Tcl_DictObjPut(interp, dictPtr, objv[i], objv[i+1]); + if (result != TCL_OK) { + if (allocatedDict) { + TclDecrRefCount(dictPtr); + } + return TCL_ERROR; + } } Tcl_SetObjResult(interp, dictPtr); return TCL_OK; @@ -1672,7 +1646,8 @@ DictRemoveCmd( Tcl_Obj *const *objv) { Tcl_Obj *dictPtr; - int i; + int i, result; + int allocatedDict = 0; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?"); @@ -1680,18 +1655,18 @@ DictRemoveCmd( } dictPtr = objv[1]; - if (dictPtr->typePtr != &tclDictType - && SetDictFromAny(interp, dictPtr) != TCL_OK) { - return TCL_ERROR; - } if (Tcl_IsShared(dictPtr)) { dictPtr = Tcl_DuplicateObj(dictPtr); - } - if (dictPtr->bytes != NULL) { - TclInvalidateStringRep(dictPtr); + allocatedDict = 1; } for (i=2 ; i<objc ; i++) { - Tcl_DictObjRemove(NULL, dictPtr, objv[i]); + result = Tcl_DictObjRemove(interp, dictPtr, objv[i]); + if (result != TCL_OK) { + if (allocatedDict) { + TclDecrRefCount(dictPtr); + } + return TCL_ERROR; + } } Tcl_SetObjResult(interp, dictPtr); return TCL_OK; @@ -1722,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; @@ -1740,9 +1715,10 @@ DictMergeCmd( */ targetObj = objv[1]; - if (targetObj->typePtr != &tclDictType - && SetDictFromAny(interp, targetObj) != TCL_OK) { - return TCL_ERROR; + if (targetObj->typePtr != &tclDictType) { + if (SetDictFromAny(interp, targetObj) != TCL_OK) { + return TCL_ERROR; + } } if (objc == 2) { @@ -1811,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?"); @@ -1824,9 +1800,12 @@ DictKeysCmd( * need. [Bug 1705778, leak K04] */ - if (objv[1]->typePtr != &tclDictType - && SetDictFromAny(interp, objv[1]) != TCL_OK) { - return TCL_ERROR; + if (objv[1]->typePtr != &tclDictType) { + int result = SetDictFromAny(interp, objv[1]); + + if (result != TCL_OK) { + return result; + } } if (objc == 3) { @@ -1842,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 @@ -1890,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?"); @@ -2034,7 +2013,6 @@ DictInfoCmd( { Tcl_Obj *dictPtr; Dict *dict; - char *statsStr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "dictionary"); @@ -2042,15 +2020,19 @@ DictInfoCmd( } dictPtr = objv[1]; - if (dictPtr->typePtr != &tclDictType - && SetDictFromAny(interp, dictPtr) != TCL_OK) { - return TCL_ERROR; + if (dictPtr->typePtr != &tclDictType) { + int result = SetDictFromAny(interp, dictPtr); + if (result != TCL_OK) { + return result; + } } - dict = DICT(dictPtr); + dict = dictPtr->internalRep.twoPtrValue.ptr1; + + /* + * This next cast is actually OK. + */ - statsStr = Tcl_HashStats(&dict->table); - Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1)); - ckfree(statsStr); + Tcl_SetResult(interp, (char *) Tcl_HashStats(&dict->table), TCL_DYNAMIC); return TCL_OK; } @@ -2083,7 +2065,7 @@ DictIncrCmd( Tcl_Obj *dictPtr, *valuePtr = NULL; if (objc < 3 || objc > 4) { - Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?increment?"); + Tcl_WrongNumArgs(interp, 1, objv, "varName key ?increment?"); return TCL_ERROR; } @@ -2136,10 +2118,10 @@ DictIncrCmd( */ mp_clear(&increment); - Tcl_DictObjPut(NULL, dictPtr, objv[2], objv[3]); + Tcl_DictObjPut(interp, dictPtr, objv[2], objv[3]); } } else { - Tcl_DictObjPut(NULL, dictPtr, objv[2], Tcl_NewIntObj(1)); + Tcl_DictObjPut(interp, dictPtr, objv[2], Tcl_NewIntObj(1)); } } else { /* @@ -2148,7 +2130,7 @@ DictIncrCmd( if (Tcl_IsShared(valuePtr)) { valuePtr = Tcl_DuplicateObj(valuePtr); - Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr); + Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr); } if (objc == 4) { code = TclIncrObj(interp, valuePtr, objv[3]); @@ -2157,7 +2139,7 @@ DictIncrCmd( Tcl_IncrRefCount(incrPtr); code = TclIncrObj(interp, valuePtr, incrPtr); - TclDecrRefCount(incrPtr); + Tcl_DecrRefCount(incrPtr); } } if (code == TCL_OK) { @@ -2170,7 +2152,7 @@ DictIncrCmd( Tcl_SetObjResult(interp, valuePtr); } } else if (dictPtr->refCount == 0) { - TclDecrRefCount(dictPtr); + Tcl_DecrRefCount(dictPtr); } return code; } @@ -2204,7 +2186,7 @@ DictLappendCmd( int i, allocatedDict = 0, allocatedValue = 0; if (objc < 3) { - Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "varName key ?value ...?"); return TCL_ERROR; } @@ -2248,7 +2230,7 @@ DictLappendCmd( } if (allocatedValue) { - Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr); + Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr); } else if (dictPtr->bytes != NULL) { TclInvalidateStringRep(dictPtr); } @@ -2291,7 +2273,7 @@ DictAppendCmd( int i, allocatedDict = 0; if (objc < 3) { - Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "varName key ?value ...?"); return TCL_ERROR; } @@ -2313,15 +2295,17 @@ DictAppendCmd( if (valuePtr == NULL) { TclNewObj(valuePtr); - } else if (Tcl_IsShared(valuePtr)) { - valuePtr = Tcl_DuplicateObj(valuePtr); + } else { + if (Tcl_IsShared(valuePtr)) { + valuePtr = Tcl_DuplicateObj(valuePtr); + } } for (i=3 ; i<objc ; i++) { Tcl_AppendObjToObj(valuePtr, objv[i]); } - Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr); + Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr); resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr, TCL_LEAVE_ERR_MSG); @@ -2335,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. * @@ -2351,7 +2335,7 @@ DictAppendCmd( */ static int -DictForNRCmd( +DictForCmd( ClientData dummy, Tcl_Interp *interp, int objc, @@ -2360,43 +2344,32 @@ 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, - "{keyVarName valueVarName} dictionary script"); + "{keyVar valueVar} dictionary script"); 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", -1)); - Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "for", NULL); + Tcl_SetResult(interp, "must have exactly two variable names", + 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 @@ -2407,335 +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, - int objc, - Tcl_Obj *const *objv) -{ - Interp *iPtr = (Interp *) interp; - Tcl_Obj **varv, *keyObj, *valueObj; - DictMapStorage *storagePtr; - int varc, done; - - if (objc != 4) { - Tcl_WrongNumArgs(interp, 1, objv, - "{keyVarName valueVarName} 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", -1)); - Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "map", NULL); - 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; - } - - /* - * 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); - result = TCL_ERROR; - goto done; + Tcl_DictObjNext(&search, &keyObj, &valueObj, &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. + * Stop holding a reference to these objects. */ - 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; } @@ -2768,7 +2470,7 @@ DictSetCmd( int result, allocatedDict = 0; if (objc < 4) { - Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?key ...? value"); + Tcl_WrongNumArgs(interp, 1, objv, "varName key ?key ...? value"); return TCL_ERROR; } @@ -2828,7 +2530,7 @@ DictUnsetCmd( int result, allocatedDict = 0; if (objc < 3) { - Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?key ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "varName key ?key ...?"); return TCL_ERROR; } @@ -2884,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", @@ -2907,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. */ @@ -2915,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(NULL, resultObj, objv[3], valueObj); - } - } else { - while (!done) { - if (Tcl_StringMatch(TclGetString(keyObj), pattern)) { - Tcl_DictObjPut(NULL, 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(NULL, 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); } @@ -2969,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. */ @@ -2977,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(NULL, 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); } @@ -2996,7 +2674,7 @@ DictFilterCmd( case FILTER_SCRIPT: if (objc != 5) { Tcl_WrongNumArgs(interp, 1, objv, - "dictionary script {keyVarName valueVarName} filterScript"); + "dictionary script {keyVar valueVar} filterScript"); return TCL_ERROR; } @@ -3010,9 +2688,8 @@ DictFilterCmd( return TCL_ERROR; } if (varc != 2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "must have exactly two variable names", -1)); - Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "filter", NULL); + Tcl_SetResult(interp, "must have exactly two variable names", + TCL_STATIC); return TCL_ERROR; } keyVarObj = varv[0]; @@ -3051,16 +2728,17 @@ DictFilterCmd( Tcl_IncrRefCount(valueObj); if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) { - Tcl_AddErrorInfo(interp, - "\n (\"dict filter\" filter script key variable)"); + Tcl_ResetResult(interp); + 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_AddErrorInfo(interp, - "\n (\"dict filter\" filter script value variable)"); - result = TCL_ERROR; + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "couldn't set value variable: \"", + TclGetString(valueVarObj), "\"", NULL); goto abnormalResult; } @@ -3082,7 +2760,7 @@ DictFilterCmd( } TclDecrRefCount(boolObj); if (satisfied) { - Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj); + Tcl_DictObjPut(interp, resultObj, keyObj, valueObj); } break; case TCL_BREAK: @@ -3100,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,11 +2847,12 @@ 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, - "dictVarName key varName ?key varName ...? script"); + "varName key varName ?key varName ...? script"); return TCL_ERROR; } @@ -3202,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\")"); } @@ -3238,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; } @@ -3250,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; } @@ -3266,37 +2917,34 @@ 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(NULL, dictPtr, objv[i]); + Tcl_DictObjRemove(interp, dictPtr, objv[i]); } else if (objPtr == dictPtr) { /* * Someone is messing us around, trying to build a recursive * structure. [Bug 1786481] */ - Tcl_DictObjPut(NULL, dictPtr, objv[i], Tcl_DuplicateObj(objPtr)); + Tcl_DictObjPut(interp, dictPtr, objv[i], + Tcl_DuplicateObj(objPtr)); } else { /* Shouldn't fail */ - Tcl_DictObjPut(NULL, dictPtr, objv[i], objPtr); + 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); } @@ -3326,10 +2974,13 @@ DictWithCmd( 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, "dictVarName ?key ...? script"); + Tcl_WrongNumArgs(interp, 1, objv, "dictVar ?key ...? script"); return TCL_ERROR; } @@ -3341,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; - int 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, - int 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; } } @@ -3473,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); @@ -3484,87 +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. */ - int 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; - int i, allocdict, keyc; - Tcl_Obj **keyv; + 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 @@ -3574,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; @@ -3612,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); } @@ -3626,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); } /* |