diff options
Diffstat (limited to 'generic/tclDictObj.c')
| -rw-r--r-- | generic/tclDictObj.c | 1049 |
1 files changed, 552 insertions, 497 deletions
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 05008cb..be0a2ef 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -1,15 +1,15 @@ -/* +/* * tclDictObj.c -- * - * This file contains procedures that implement the Tcl dict object - * type and its accessor command. + * This file contains functions that implement the Tcl dict object type + * and its accessor command. * * 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. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDictObj.c,v 1.37 2005/10/19 18:39:58 dgp Exp $ + * RCS: @(#) $Id: tclDictObj.c,v 1.38 2005/11/01 15:30:52 dkf Exp $ */ #include "tclInt.h" @@ -21,82 +21,81 @@ struct Dict; /* - * Prototypes for procedures defined later in this file: + * Prototypes for functions defined later in this file: */ -static void DeleteDict _ANSI_ARGS_((struct Dict *dict)); -static int DictAppendCmd _ANSI_ARGS_((Tcl_Interp *interp, - int objc, Tcl_Obj *CONST *objv)); -static int DictCreateCmd _ANSI_ARGS_((Tcl_Interp *interp, - int objc, Tcl_Obj *CONST *objv)); -static int DictExistsCmd _ANSI_ARGS_((Tcl_Interp *interp, - int objc, Tcl_Obj *CONST *objv)); -static int DictFilterCmd _ANSI_ARGS_((Tcl_Interp *interp, - int objc, Tcl_Obj *CONST *objv)); -static int DictForCmd _ANSI_ARGS_((Tcl_Interp *interp, - int objc, Tcl_Obj *CONST *objv)); -static int DictGetCmd _ANSI_ARGS_((Tcl_Interp *interp, - int objc, Tcl_Obj *CONST *objv)); -static int DictIncrCmd _ANSI_ARGS_((Tcl_Interp *interp, - int objc, Tcl_Obj *CONST *objv)); -static int DictInfoCmd _ANSI_ARGS_((Tcl_Interp *interp, - int objc, Tcl_Obj *CONST *objv)); -static int DictKeysCmd _ANSI_ARGS_((Tcl_Interp *interp, - int objc, Tcl_Obj *CONST *objv)); -static int DictLappendCmd _ANSI_ARGS_((Tcl_Interp *interp, - int objc, Tcl_Obj *CONST *objv)); -static int DictMergeCmd _ANSI_ARGS_((Tcl_Interp *interp, - int objc, Tcl_Obj *CONST *objv)); -static int DictRemoveCmd _ANSI_ARGS_((Tcl_Interp *interp, - int objc, Tcl_Obj *CONST *objv)); -static int DictReplaceCmd _ANSI_ARGS_((Tcl_Interp *interp, - int objc, Tcl_Obj *CONST *objv)); -static int DictSetCmd _ANSI_ARGS_((Tcl_Interp *interp, - int objc, Tcl_Obj *CONST *objv)); -static int DictSizeCmd _ANSI_ARGS_((Tcl_Interp *interp, - int objc, Tcl_Obj *CONST *objv)); -static int DictUnsetCmd _ANSI_ARGS_((Tcl_Interp *interp, - int objc, Tcl_Obj *CONST *objv)); -static int DictValuesCmd _ANSI_ARGS_((Tcl_Interp *interp, - int objc, Tcl_Obj *CONST *objv)); -static int DictUpdateCmd _ANSI_ARGS_((Tcl_Interp *interp, - int objc, Tcl_Obj *CONST *objv)); -static int DictWithCmd _ANSI_ARGS_((Tcl_Interp *interp, - int objc, Tcl_Obj *CONST *objv)); -static void DupDictInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr, - Tcl_Obj *copyPtr)); -static void FreeDictInternalRep _ANSI_ARGS_((Tcl_Obj *dictPtr)); -static void InvalidateDictChain _ANSI_ARGS_((Tcl_Obj *dictObj)); -static int SetDictFromAny _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *objPtr)); -static void UpdateStringOfDict _ANSI_ARGS_((Tcl_Obj *dictPtr)); +static void DeleteDict(struct Dict *dict); +static int DictAppendCmd(Tcl_Interp *interp, + int objc, Tcl_Obj *CONST *objv); +static int DictCreateCmd(Tcl_Interp *interp, + int objc, Tcl_Obj *CONST *objv); +static int DictExistsCmd(Tcl_Interp *interp, + int objc, Tcl_Obj *CONST *objv); +static int DictFilterCmd(Tcl_Interp *interp, + int objc, Tcl_Obj *CONST *objv); +static int DictForCmd(Tcl_Interp *interp, + int objc, Tcl_Obj *CONST *objv); +static int DictGetCmd(Tcl_Interp *interp, + int objc, Tcl_Obj *CONST *objv); +static int DictIncrCmd(Tcl_Interp *interp, + int objc, Tcl_Obj *CONST *objv); +static int DictInfoCmd(Tcl_Interp *interp, + int objc, Tcl_Obj *CONST *objv); +static int DictKeysCmd(Tcl_Interp *interp, + int objc, Tcl_Obj *CONST *objv); +static int DictLappendCmd(Tcl_Interp *interp, + int objc, Tcl_Obj *CONST *objv); +static int DictMergeCmd(Tcl_Interp *interp, + int objc, Tcl_Obj *CONST *objv); +static int DictRemoveCmd(Tcl_Interp *interp, + int objc, Tcl_Obj *CONST *objv); +static int DictReplaceCmd(Tcl_Interp *interp, + int objc, Tcl_Obj *CONST *objv); +static int DictSetCmd(Tcl_Interp *interp, + int objc, Tcl_Obj *CONST *objv); +static int DictSizeCmd(Tcl_Interp *interp, + int objc, Tcl_Obj *CONST *objv); +static int DictUnsetCmd(Tcl_Interp *interp, + int objc, Tcl_Obj *CONST *objv); +static int DictValuesCmd(Tcl_Interp *interp, + int objc, Tcl_Obj *CONST *objv); +static int DictUpdateCmd(Tcl_Interp *interp, + int objc, Tcl_Obj *CONST *objv); +static int DictWithCmd(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); +static int SetDictFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); +static void UpdateStringOfDict(Tcl_Obj *dictPtr); /* * Internal representation of a dictionary. * - * The internal representation of a dictionary object is a hash table - * (with Tcl_Objs for both keys and values), a reference count and - * epoch number for detecting concurrent modifications of the - * dictionary, and a pointer to the parent object (used when - * invalidating string reps of pathed dictionary trees) which is NULL - * in normal use. The fact that hash tables know (with appropriate - * initialisation) already about objects makes key management /so/ + * The internal representation of a dictionary object is a hash table (with + * Tcl_Objs for both keys and values), a reference count and epoch number for + * detecting concurrent modifications of the dictionary, and a pointer to the + * parent object (used when invalidating string reps of pathed dictionary + * trees) which is NULL in normal use. The fact that hash tables know (with + * appropriate initialisation) already about objects makes key management /so/ * much easier! * - * Reference counts are used to enable safe iteration across hashes - * while allowing the type of the containing object to be modified. + * Reference counts are used to enable safe iteration across hashes while + * allowing the type of the containing object to be modified. */ typedef struct Dict { - Tcl_HashTable table; - int epoch; - int refcount; - Tcl_Obj *chain; + Tcl_HashTable table; /* Object hash table to store mapping in. */ + int epoch; /* Epoch counter */ + int refcount; /* Reference counter (see above) */ + Tcl_Obj *chain; /* Linked list used for invalidating the + * string representations of updated nested + * dictionaries. */ } Dict; /* * The structure below defines the dictionary object type by means of - * procedures that can be invoked by generic object code. + * functions that can be invoked by generic object code. */ Tcl_ObjType tclDictType = { @@ -112,27 +111,27 @@ Tcl_ObjType tclDictType = { * * DupDictInternalRep -- * - * Initialize the internal representation of a dictionary Tcl_Obj - * to a copy of the internal representation of an existing - * dictionary object. + * Initialize the internal representation of a dictionary Tcl_Obj to a + * copy of the internal representation of an existing dictionary object. * * Results: * None. * * Side effects: - * "srcPtr"s dictionary internal rep pointer should not be NULL and - * we assume it is not NULL. We set "copyPtr"s internal rep to a - * pointer to a newly allocated dictionary rep that, in turn, points - * to "srcPtr"s key and value objects. Those objects are not - * actually copied but are shared between "srcPtr" and "copyPtr". - * The ref count of each key and value object is incremented. + * "srcPtr"s dictionary internal rep pointer should not be NULL and we + * assume it is not NULL. We set "copyPtr"s internal rep to a pointer to + * a newly allocated dictionary rep that, in turn, points to "srcPtr"s + * key and value objects. Those objects are not actually copied but are + * shared between "srcPtr" and "copyPtr". The ref count of each key and + * value object is incremented. * *---------------------------------------------------------------------- */ static void -DupDictInternalRep(srcPtr, copyPtr) - Tcl_Obj *srcPtr, *copyPtr; +DupDictInternalRep( + Tcl_Obj *srcPtr, + Tcl_Obj *copyPtr) { Dict *oldDict = (Dict *) srcPtr->internalRep.otherValuePtr; Dict *newDict = (Dict *) ckalloc(sizeof(Dict)); @@ -164,7 +163,7 @@ DupDictInternalRep(srcPtr, copyPtr) /* * Store in the object. */ - copyPtr->internalRep.otherValuePtr = (VOID *) newDict; + copyPtr->internalRep.otherValuePtr = (void *) newDict; copyPtr->typePtr = &tclDictType; } @@ -173,23 +172,22 @@ DupDictInternalRep(srcPtr, copyPtr) * * FreeDictInternalRep -- * - * Deallocate the storage associated with a dictionary object's - * internal representation. + * Deallocate the storage associated with a dictionary object's internal + * representation. * * Results: * None * * Side effects: - * Frees the memory holding the dictionary's internal hash table - * unless it is locked by an iteration going over it. + * Frees the memory holding the dictionary's internal hash table unless + * it is locked by an iteration going over it. * *---------------------------------------------------------------------- - */ static void -FreeDictInternalRep(dictPtr) - Tcl_Obj *dictPtr; +FreeDictInternalRep( + Tcl_Obj *dictPtr) { Dict *dict = (Dict *) dictPtr->internalRep.otherValuePtr; @@ -206,34 +204,35 @@ FreeDictInternalRep(dictPtr) * * DeleteDict -- * - * Delete the structure that is used to implement a dictionary's - * internal representation. Called when either the dictionary - * object loses its internal representation or when the last - * iteration over the dictionary completes. + * Delete the structure that is used to implement a dictionary's internal + * representation. Called when either the dictionary object loses its + * internal representation or when the last iteration over the dictionary + * completes. * * Results: * None * * Side effects: - * Decrements the reference count of all key and value objects in - * the dictionary, which may free them. + * Decrements the reference count of all key and value objects in the + * dictionary, which may free them. * *---------------------------------------------------------------------- */ static void -DeleteDict(dict) - Dict *dict; +DeleteDict( + Dict *dict) { Tcl_HashEntry *hPtr; Tcl_HashSearch search; Tcl_Obj *valuePtr; /* - * Delete the values ourselves, because hashes know nothing about - * their contents (but do know about the key type, so that doesn't - * need explicit attention.) + * Delete the values ourselves, because hashes know nothing about their + * contents (but do know about the key type, so that doesn't need explicit + * attention.) */ + for (hPtr=Tcl_FirstHashEntry(&dict->table,&search); hPtr!=NULL; hPtr=Tcl_NextHashEntry(&search)) { valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr); @@ -248,26 +247,26 @@ DeleteDict(dict) * * UpdateStringOfDict -- * - * Update the string representation for a dictionary object. - * Note: This procedure does not invalidate an existing old string - * rep so storage will be lost if this has not already been done. - * This code is based on UpdateStringOfList in tclListObj.c + * Update the string representation for a dictionary object. Note: This + * function does not invalidate an existing old string rep so storage + * will be lost if this has not already been done. This code is based on + * UpdateStringOfList in tclListObj.c * * Results: * None. * * Side effects: - * The object's string is set to a valid string that results from - * the dict-to-string conversion. This string will be empty if the - * dictionary has no key/value pairs. The dictionary internal - * representation should not be NULL and we assume it is not NULL. + * The object's string is set to a valid string that results from the + * dict-to-string conversion. This string will be empty if the dictionary + * has no key/value pairs. The dictionary internal representation should + * not be NULL and we assume it is not NULL. * *---------------------------------------------------------------------- */ static void -UpdateStringOfDict(dictPtr) - Tcl_Obj *dictPtr; +UpdateStringOfDict( + Tcl_Obj *dictPtr) { #define LOCAL_SIZE 20 int localFlags[LOCAL_SIZE], *flagPtr; @@ -279,9 +278,10 @@ UpdateStringOfDict(dictPtr) char *elem, *dst; /* - * This field is the most useful one in the whole hash structure, - * and it is not exposed by any API function... + * This field is the most useful one in the whole hash structure, and it + * is not exposed by any API function... */ + numElems = dict->table.numEntries * 2; /* @@ -297,8 +297,8 @@ UpdateStringOfDict(dictPtr) for (i=0,hPtr=Tcl_FirstHashEntry(&dict->table,&search) ; i<numElems ; i+=2,hPtr=Tcl_NextHashEntry(&search)) { /* - * Assume that hPtr is never NULL since we know the number of - * array elements already. + * Assume that hPtr is never NULL since we know the number of array + * elements already. */ keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, hPtr); @@ -348,11 +348,10 @@ UpdateStringOfDict(dictPtr) * * SetDictFromAny -- * - * Convert a non-dictionary object into a dictionary object. This - * code is very closely related to SetListFromAny in tclListObj.c - * but does not actually guarantee that a dictionary object will - * have a string rep (as conversions from lists are handled with a - * special case.) + * Convert a non-dictionary object into a dictionary object. This code is + * very closely related to SetListFromAny in tclListObj.c but does not + * actually guarantee that a dictionary object will have a string rep (as + * conversions from lists are handled with a special case.) * * Results: * A standard Tcl result. @@ -365,9 +364,9 @@ UpdateStringOfDict(dictPtr) */ static int -SetDictFromAny(interp, objPtr) - Tcl_Interp *interp; - Tcl_Obj *objPtr; +SetDictFromAny( + Tcl_Interp *interp, + Tcl_Obj *objPtr) { char *string, *s; CONST char *elemStart, *nextElem; @@ -381,8 +380,8 @@ SetDictFromAny(interp, objPtr) /* * Since lists and dictionaries have very closely-related string - * representations (i.e. the same parsing code) we can safely - * special-case the conversion from lists to dictionaries. + * representations (i.e. the same parsing code) we can safely special-case + * the conversion from lists to dictionaries. */ if (objPtr->typePtr == &tclListType) { @@ -401,8 +400,8 @@ SetDictFromAny(interp, objPtr) } /* - * If the list is shared its string rep must not be lost so it - * still is the same list. + * If the list is shared its string rep must not be lost so it still + * is the same list. */ if (Tcl_IsShared(objPtr)) { @@ -431,6 +430,7 @@ SetDictFromAny(interp, objPtr) /* * Share type-setting code with the string-conversion case. */ + goto installHash; } @@ -442,8 +442,8 @@ SetDictFromAny(interp, objPtr) limit = (string + length); /* - * Allocate a new HashTable that has objects for keys and objects - * for values. + * Allocate a new HashTable that has objects for keys and objects for + * values. */ dict = (Dict *) ckalloc(sizeof(Dict)); @@ -467,14 +467,14 @@ SetDictFromAny(interp, objPtr) s = ckalloc((unsigned) elemSize + 1); if (hasBrace) { - memcpy((VOID *) s, (VOID *) elemStart, (size_t) elemSize); + memcpy((void *) s, (void *) elemStart, (size_t) elemSize); s[elemSize] = 0; } else { elemSize = TclCopyAndCollapse(elemSize, elemStart, s); } - + TclNewObj(keyPtr); - keyPtr->bytes = s; + keyPtr->bytes = s; keyPtr->length = elemSize; p = nextElem; @@ -500,19 +500,20 @@ SetDictFromAny(interp, objPtr) s = ckalloc((unsigned) elemSize + 1); if (hasBrace) { - memcpy((VOID *) s, (VOID *) elemStart, (size_t) elemSize); + memcpy((void *) s, (void *) elemStart, (size_t) elemSize); s[elemSize] = 0; } else { elemSize = TclCopyAndCollapse(elemSize, elemStart, s); } TclNewObj(valuePtr); - valuePtr->bytes = s; + valuePtr->bytes = s; valuePtr->length = elemSize; /* * Store key and value in the hash table we're building. */ + hPtr = Tcl_CreateHashEntry(&dict->table, (char *)keyPtr, &isNew); if (!isNew) { Tcl_Obj *discardedValue = (Tcl_Obj *) Tcl_GetHashValue(hPtr); @@ -525,8 +526,8 @@ SetDictFromAny(interp, objPtr) installHash: /* - * Free the old internalRep before setting the new one. We do this as - * late as possible to allow the conversion code, in particular + * Free the old internalRep before setting the new one. We do this as late + * as possible to allow the conversion code, in particular * Tcl_GetStringFromObj, to use that old internalRep. */ @@ -534,7 +535,7 @@ SetDictFromAny(interp, objPtr) dict->epoch = 0; dict->chain = NULL; dict->refcount = 1; - objPtr->internalRep.otherValuePtr = (VOID *) dict; + objPtr->internalRep.otherValuePtr = (void *) dict; objPtr->typePtr = &tclDictType; return TCL_OK; @@ -547,7 +548,7 @@ SetDictFromAny(interp, objPtr) result = TCL_ERROR; errorExit: for (hPtr=Tcl_FirstHashEntry(&dict->table,&search); - hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) { + hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) { valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr); TclDecrRefCount(valuePtr); } @@ -561,29 +562,27 @@ SetDictFromAny(interp, objPtr) * * TclTraceDictPath -- * - * Trace through a tree of dictionaries using the array of keys - * given. If the flags argument has the DICT_PATH_UPDATE flag is - * set, a backward-pointing chain of dictionaries is also built - * (in the Dict's chain field) and the chained dictionaries are - * made into unshared dictionaries (if they aren't already.) + * Trace through a tree of dictionaries using the array of keys given. If + * the flags argument has the DICT_PATH_UPDATE flag is set, a + * backward-pointing chain of dictionaries is also built (in the Dict's + * chain field) and the chained dictionaries are made into unshared + * dictionaries (if they aren't already.) * * Results: - * The object at the end of the path, or NULL if there was an - * error. Note that this it is an error for an intermediate - * dictionary on the path to not exist. If the flags argument - * has the DICT_PATH_EXISTS set, a non-existent path gives a - * DICT_PATH_NON_EXISTENT result. + * The object at the end of the path, or NULL if there was an error. Note + * that this it is an error for an intermediate dictionary on the path to + * not exist. If the flags argument has the DICT_PATH_EXISTS set, a + * non-existent path gives a DICT_PATH_NON_EXISTENT result. * * Side effects: - * If the flags argument is zero or DICT_PATH_EXISTS, there are - * no side effects (other than potential conversion of objects to - * dictionaries.) If the flags argument is DICT_PATH_UPDATE, the - * following additional side effects occur. Shared dictionaries - * along the path are converted into unshared objects, and a - * backward-pointing chain is built using the chain fields of the - * dictionaries (for easy invalidation of string representations - * using InvalidateDictChain.) If the flags argument has the - * DICT_PATH_CREATE bits set (and not the DICT_PATH_EXISTS bit), + * If the flags argument is zero or DICT_PATH_EXISTS, there are no side + * effects (other than potential conversion of objects to dictionaries.) + * If the flags argument is DICT_PATH_UPDATE, the following additional + * side effects occur. Shared dictionaries along the path are converted + * into unshared objects, and a backward-pointing chain is built using + * the chain fields of the dictionaries (for easy invalidation of string + * representations using InvalidateDictChain). If the flags argument has + * the DICT_PATH_CREATE bits set (and not the DICT_PATH_EXISTS bit), * non-existant keys will be inserted with a value of an empty * dictionary, resulting in the path being built. * @@ -591,10 +590,12 @@ SetDictFromAny(interp, objPtr) */ Tcl_Obj * -TclTraceDictPath(interp, dictPtr, keyc, keyv, flags) - Tcl_Interp *interp; - Tcl_Obj *dictPtr, *CONST keyv[]; - int keyc, flags; +TclTraceDictPath( + Tcl_Interp *interp, + Tcl_Obj *dictPtr, + int keyc, + Tcl_Obj *CONST keyv[], + int flags) { Dict *dict, *newDict; int i; @@ -667,24 +668,24 @@ TclTraceDictPath(interp, dictPtr, keyc, keyv, flags) * * InvalidateDictChain -- * - * Go through a dictionary chain (built by an updating invokation - * of TclTraceDictPath) and invalidate the string representations - * of all the dictionaries on the chain. + * Go through a dictionary chain (built by an updating invokation of + * TclTraceDictPath) and invalidate the string representations of all the + * dictionaries on the chain. * * Results: * None * * Side effects: - * String reps are invalidated and epoch counters (for detecting - * illegal concurrent modifications) are updated through the - * chain of updated dictionaries. + * String reps are invalidated and epoch counters (for detecting illegal + * concurrent modifications) are updated through the chain of updated + * dictionaries. * *---------------------------------------------------------------------- */ static void -InvalidateDictChain(dictObj) - Tcl_Obj *dictObj; +InvalidateDictChain( + Tcl_Obj *dictObj) { Dict *dict = (Dict *) dictObj->internalRep.otherValuePtr; @@ -705,24 +706,26 @@ InvalidateDictChain(dictObj) * * Tcl_DictObjPut -- * - * Add a key,value pair to a dictionary, or update the value for a - * key if that key already has a mapping in the dictionary. + * Add a key,value pair to a dictionary, or update the value for a key if + * that key already has a mapping in the dictionary. * * Results: * A standard Tcl result. * * Side effects: - * The object pointed to by dictPtr is converted to a dictionary if - * it is not already one, and any string representation that it has - * is invalidated. + * The object pointed to by dictPtr is converted to a dictionary if it is + * not already one, and any string representation that it has is + * invalidated. * *---------------------------------------------------------------------- */ int -Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr) - Tcl_Interp *interp; - Tcl_Obj *dictPtr, *keyPtr, *valuePtr; +Tcl_DictObjPut( + Tcl_Interp *interp, + Tcl_Obj *dictPtr, + Tcl_Obj *keyPtr, + Tcl_Obj *valuePtr) { Dict *dict; Tcl_HashEntry *hPtr; @@ -759,25 +762,27 @@ Tcl_DictObjPut(interp, dictPtr, keyPtr, valuePtr) * * Tcl_DictObjGet -- * - * Given a key, get its value from the dictionary (or NULL if key - * is not found in dictionary.) + * Given a key, get its value from the dictionary (or NULL if key is not + * found in dictionary.) * * Results: - * A standard Tcl result. The variable pointed to by valuePtrPtr - * is updated with the value for the key. Note that it is not an - * error for the key to have no mapping in the dictionary. + * A standard Tcl result. The variable pointed to by valuePtrPtr is + * updated with the value for the key. Note that it is not an error for + * the key to have no mapping in the dictionary. * * Side effects: - * The object pointed to by dictPtr is converted to a dictionary if - * it is not already one. + * The object pointed to by dictPtr is converted to a dictionary if it is + * not already one. * *---------------------------------------------------------------------- */ int -Tcl_DictObjGet(interp, dictPtr, keyPtr, valuePtrPtr) - Tcl_Interp *interp; - Tcl_Obj *dictPtr, *keyPtr, **valuePtrPtr; +Tcl_DictObjGet( + Tcl_Interp *interp, + Tcl_Obj *dictPtr, + Tcl_Obj *keyPtr, + Tcl_Obj **valuePtrPtr) { Dict *dict; Tcl_HashEntry *hPtr; @@ -804,24 +809,25 @@ Tcl_DictObjGet(interp, dictPtr, keyPtr, valuePtrPtr) * * Tcl_DictObjRemove -- * - * Remove the key,value pair with the given key from the dictionary; - * the key does not need to be present in the dictionary. + * Remove the key,value pair with the given key from the dictionary; the + * key does not need to be present in the dictionary. * * Results: * A standard Tcl result. * * Side effects: - * The object pointed to by dictPtr is converted to a dictionary if - * it is not already one, and any string representation that it has - * is invalidated. + * The object pointed to by dictPtr is converted to a dictionary if it is + * not already one, and any string representation that it has is + * invalidated. * *---------------------------------------------------------------------- */ int -Tcl_DictObjRemove(interp, dictPtr, keyPtr) - Tcl_Interp *interp; - Tcl_Obj *dictPtr, *keyPtr; +Tcl_DictObjRemove( + Tcl_Interp *interp, + Tcl_Obj *dictPtr, + Tcl_Obj *keyPtr) { Dict *dict; Tcl_HashEntry *hPtr; @@ -860,21 +866,21 @@ Tcl_DictObjRemove(interp, dictPtr, keyPtr) * How many key,value pairs are there in the dictionary? * * Results: - * A standard Tcl result. Updates the variable pointed to by - * sizePtr with the number of key,value pairs in the dictionary. + * A standard Tcl result. Updates the variable pointed to by sizePtr with + * the number of key,value pairs in the dictionary. * * Side effects: - * The dictPtr object is converted to a dictionary type if it is - * not a dictionary already. + * The dictPtr object is converted to a dictionary type if it is not a + * dictionary already. * *---------------------------------------------------------------------- */ int -Tcl_DictObjSize(interp, dictPtr, sizePtr) - Tcl_Interp *interp; - Tcl_Obj *dictPtr; - int *sizePtr; +Tcl_DictObjSize( + Tcl_Interp *interp, + Tcl_Obj *dictPtr, + int *sizePtr) { Dict *dict; @@ -895,41 +901,39 @@ Tcl_DictObjSize(interp, dictPtr, sizePtr) * * Tcl_DictObjFirst -- * - * Start a traversal of the dictionary. Caller must supply the - * search context, pointers for returning key and value, and a - * pointer to allow indication of whether the dictionary has been - * traversed (i.e. the dictionary is empty.) The order of traversal - * is undefined. + * Start a traversal of the dictionary. Caller must supply the search + * context, pointers for returning key and value, and a pointer to allow + * indication of whether the dictionary has been traversed (i.e. the + * dictionary is empty). The order of traversal is undefined. * * Results: - * A standard Tcl result. Updates the variables pointed to by - * keyPtrPtr, valuePtrPtr and donePtr. Either of keyPtrPtr and - * valuePtrPtr may be NULL, in which case the key/value is not made - * available to the caller. + * A standard Tcl result. Updates the variables pointed to by keyPtrPtr, + * valuePtrPtr and donePtr. Either of keyPtrPtr and valuePtrPtr may be + * NULL, in which case the key/value is not made available to the caller. * * Side effects: - * The dictPtr object is converted to a dictionary type if it is - * not a dictionary already. The search context is initialised if - * the search has not finished. The dictionary's internal rep is - * Tcl_Preserve()d if the dictionary has at least one element. + * The dictPtr object is converted to a dictionary type if it is not a + * dictionary already. The search context is initialised if the search + * has not finished. The dictionary's internal rep is Tcl_Preserve()d if + * the dictionary has at least one element. * *---------------------------------------------------------------------- */ int -Tcl_DictObjFirst(interp, dictPtr, searchPtr, keyPtrPtr, valuePtrPtr, donePtr) - Tcl_Interp *interp; /* For error messages, or NULL if no - * error messages desired. */ - Tcl_Obj *dictPtr; /* Dictionary to traverse. */ - Tcl_DictSearch *searchPtr; /* Pointer to a dict search context. */ - Tcl_Obj **keyPtrPtr; /* Pointer to a variable to have the - * first key written into, or NULL. */ - Tcl_Obj **valuePtrPtr; /* Pointer to a variable to have the - * first value written into, or NULL.*/ - int *donePtr; /* Pointer to a variable which will - * have a 1 written into when there - * are no further values in the - * dictionary, or a 0 otherwise. */ +Tcl_DictObjFirst( + Tcl_Interp *interp, /* For error messages, or NULL if no error + * messages desired. */ + Tcl_Obj *dictPtr, /* Dictionary to traverse. */ + Tcl_DictSearch *searchPtr, /* Pointer to a dict search context. */ + Tcl_Obj **keyPtrPtr, /* Pointer to a variable to have the first key + * written into, or NULL. */ + Tcl_Obj **valuePtrPtr, /* Pointer to a variable to have the first + * value written into, or NULL.*/ + int *donePtr) /* Pointer to a variable which will have a 1 + * written into when there are no further + * values in the dictionary, or a 0 + * otherwise. */ { Dict *dict; Tcl_HashEntry *hPtr; @@ -967,51 +971,53 @@ Tcl_DictObjFirst(interp, dictPtr, searchPtr, keyPtrPtr, valuePtrPtr, donePtr) * Tcl_DictObjNext -- * * Continue a traversal of a dictionary previously started with - * Tcl_DictObjFirst. This function is safe against concurrent - * modification of the underlying object (including type - * shimmering), treating such situations as if the search has - * terminated, though it is up to the caller to ensure that the - * object itself is not disposed until the search has finished. - * It is _not_ safe against modifications from other threads. + * Tcl_DictObjFirst. This function is safe against concurrent + * modification of the underlying object (including type shimmering), + * treating such situations as if the search has terminated, though it is + * up to the caller to ensure that the object itself is not disposed + * until the search has finished. It is _not_ safe against modifications + * from other threads. * * Results: * Updates the variables pointed to by keyPtrPtr, valuePtrPtr and - * donePtr. Either of keyPtrPtr and valuePtrPtr may be NULL, in - * which case the key/value is not made available to the caller. + * donePtr. Either of keyPtrPtr and valuePtrPtr may be NULL, in which + * case the key/value is not made available to the caller. * * Side effects: - * Removes a reference to the dictionary's internal rep if the - * search terminates. + * Removes a reference to the dictionary's internal rep if the search + * terminates. * *---------------------------------------------------------------------- */ void -Tcl_DictObjNext(searchPtr, keyPtrPtr, valuePtrPtr, donePtr) - Tcl_DictSearch *searchPtr; /* Pointer to a hash search context. */ - Tcl_Obj **keyPtrPtr; /* Pointer to a variable to have the - * first key written into, or NULL. */ - Tcl_Obj **valuePtrPtr; /* Pointer to a variable to have the - * first value written into, or NULL.*/ - int *donePtr; /* Pointer to a variable which will - * have a 1 written into when there - * are no further values in the - * dictionary, or a 0 otherwise. */ +Tcl_DictObjNext( + Tcl_DictSearch *searchPtr, /* Pointer to a hash search context. */ + Tcl_Obj **keyPtrPtr, /* Pointer to a variable to have the first key + * written into, or NULL. */ + Tcl_Obj **valuePtrPtr, /* Pointer to a variable to have the first + * value written into, or NULL.*/ + int *donePtr) /* Pointer to a variable which will have a 1 + * written into when there are no further + * values in the dictionary, or a 0 + * otherwise. */ { Tcl_HashEntry *hPtr; /* * If the searh is done; we do no work. */ + if (searchPtr->epoch == -1) { *donePtr = 1; return; } /* - * Bail out if the dictionary has had any elements added, modified - * or removed. This *shouldn't* happen, but... + * Bail out if the dictionary has had any elements added, modified or + * removed. This *shouldn't* happen, but... */ + if (((Dict *)searchPtr->dictionaryPtr)->epoch != searchPtr->epoch) { Tcl_Panic("concurrent dictionary modification and search"); } @@ -1038,11 +1044,10 @@ Tcl_DictObjNext(searchPtr, keyPtrPtr, valuePtrPtr, donePtr) * * Tcl_DictObjDone -- * - * Call this if you want to stop a search before you reach the - * end of the dictionary (e.g. because of abnormal termination of - * the search.) It should not be used if the search reaches its - * natural end (i.e. if either Tcl_DictObjFirst or Tcl_DictObjNext - * sets its donePtr variable to 1.) + * Call this if you want to stop a search before you reach the end of the + * dictionary (e.g. because of abnormal termination of the search). It + * need not be used if the search reaches its natural end (i.e. if either + * Tcl_DictObjFirst or Tcl_DictObjNext sets its donePtr variable to 1). * * Results: * None. @@ -1054,8 +1059,8 @@ Tcl_DictObjNext(searchPtr, keyPtrPtr, valuePtrPtr, donePtr) */ void -Tcl_DictObjDone(searchPtr) - Tcl_DictSearch *searchPtr; /* Pointer to a hash search context. */ +Tcl_DictObjDone( + Tcl_DictSearch *searchPtr) /* Pointer to a hash search context. */ { Dict *dict; @@ -1074,26 +1079,28 @@ Tcl_DictObjDone(searchPtr) * * Tcl_DictObjPutKeyList -- * - * Add a key...key,value pair to a dictionary tree. The main - * dictionary value must not be shared, though sub-dictionaries may - * be. All intermediate dictionaries on the path must exist. + * Add a key...key,value pair to a dictionary tree. The main dictionary + * value must not be shared, though sub-dictionaries may be. All + * intermediate dictionaries on the path must exist. * * Results: - * A standard Tcl result. Note that in the error case, a message - * is left in interp unless that is NULL. + * A standard Tcl result. Note that in the error case, a message is left + * in interp unless that is NULL. * * Side effects: - * If the dictionary and any of its sub-dictionaries on the - * path have string representations, these are invalidated. + * If the dictionary and any of its sub-dictionaries on the path have + * string representations, these are invalidated. * *---------------------------------------------------------------------- */ int -Tcl_DictObjPutKeyList(interp, dictPtr, keyc, keyv, valuePtr) - Tcl_Interp *interp; - int keyc; - Tcl_Obj *dictPtr, *CONST keyv[], *valuePtr; +Tcl_DictObjPutKeyList( + Tcl_Interp *interp, + Tcl_Obj *dictPtr, + int keyc, + Tcl_Obj *CONST keyv[], + Tcl_Obj *valuePtr) { Dict *dict; Tcl_HashEntry *hPtr; @@ -1130,27 +1137,28 @@ Tcl_DictObjPutKeyList(interp, dictPtr, keyc, keyv, valuePtr) * Tcl_DictObjRemoveKeyList -- * * Remove a key...key,value pair from a dictionary tree (the value - * removed is implicit in the key path.) The main dictionary value - * must not be shared, though sub-dictionaries may be. It is not - * an error if there is no value associated with the given key list, - * but all intermediate dictionaries on the key path must exist. + * removed is implicit in the key path). The main dictionary value must + * not be shared, though sub-dictionaries may be. It is not an error if + * there is no value associated with the given key list, but all + * intermediate dictionaries on the key path must exist. * * Results: - * A standard Tcl result. Note that in the error case, a message - * is left in interp unless that is NULL. + * A standard Tcl result. Note that in the error case, a message is left + * in interp unless that is NULL. * * Side effects: - * If the dictionary and any of its sub-dictionaries on the key - * path have string representations, these are invalidated. + * If the dictionary and any of its sub-dictionaries on the key path have + * string representations, these are invalidated. * *---------------------------------------------------------------------- */ int -Tcl_DictObjRemoveKeyList(interp, dictPtr, keyc, keyv) - Tcl_Interp *interp; - int keyc; - Tcl_Obj *dictPtr, *CONST keyv[]; +Tcl_DictObjRemoveKeyList( + Tcl_Interp *interp, + Tcl_Obj *dictPtr, + int keyc, + Tcl_Obj *CONST keyv[]) { Dict *dict; Tcl_HashEntry *hPtr; @@ -1183,17 +1191,17 @@ Tcl_DictObjRemoveKeyList(interp, dictPtr, keyc, keyv) * * Tcl_NewDictObj -- * - * This procedure is normally called when not debugging: i.e., when - * TCL_MEM_DEBUG is not defined. It creates a new dict object - * without any content. + * This function is normally called when not debugging: i.e., when + * TCL_MEM_DEBUG is not defined. It creates a new dict object without any + * content. * - * When TCL_MEM_DEBUG is defined, this procedure just returns the - * result of calling the debugging version Tcl_DbNewDictObj. + * When TCL_MEM_DEBUG is defined, this function just returns the result + * of calling the debugging version Tcl_DbNewDictObj. * * Results: - * A new dict object is returned; it has no keys defined in it. - * The new object's string representation is left NULL, and the - * ref count of the object is 0. + * A new dict object is returned; it has no keys defined in it. The new + * object's string representation is left NULL, and the ref count of the + * object is 0. * * Side Effects: * None. @@ -1202,11 +1210,12 @@ Tcl_DictObjRemoveKeyList(interp, dictPtr, keyc, keyv) */ Tcl_Obj * -Tcl_NewDictObj() +Tcl_NewDictObj(void) { #ifdef TCL_MEM_DEBUG return Tcl_DbNewDictObj("unknown", 0); #else /* !TCL_MEM_DEBUG */ + Tcl_Obj *dictPtr; Dict *dict; @@ -1217,7 +1226,7 @@ Tcl_NewDictObj() dict->epoch = 0; dict->chain = NULL; dict->refcount = 1; - dictPtr->internalRep.otherValuePtr = (VOID *) dict; + dictPtr->internalRep.otherValuePtr = (void *) dict; dictPtr->typePtr = &tclDictType; return dictPtr; #endif @@ -1228,21 +1237,21 @@ Tcl_NewDictObj() * * Tcl_DbNewDictObj -- * - * This procedure is normally called when debugging: i.e., when - * TCL_MEM_DEBUG is defined. It creates new dict objects. It is the - * same as the Tcl_NewDictObj procedure above except that it calls + * This function is normally called when debugging: i.e., when + * TCL_MEM_DEBUG is defined. It creates new dict objects. It is the same + * as the Tcl_NewDictObj function above except that it calls * Tcl_DbCkalloc directly with the file name and line number from its * caller. This simplifies debugging since then the [memory active] - * command will report the correct file name and line number when + * command will report the correct file name and line number when * reporting objects that haven't been freed. * - * When TCL_MEM_DEBUG is not defined, this procedure just returns the + * When TCL_MEM_DEBUG is not defined, this function just returns the * result of calling Tcl_NewDictObj. * * Results: - * A new dict object is returned; it has no keys defined in it. - * The new object's string representation is left NULL, and the - * ref count of the object is 0. + * A new dict object is returned; it has no keys defined in it. The new + * object's string representation is left NULL, and the ref count of the + * object is 0. * * Side Effects: * None. @@ -1251,9 +1260,9 @@ Tcl_NewDictObj() */ Tcl_Obj * -Tcl_DbNewDictObj(file, line) - CONST char *file; - int line; +Tcl_DbNewDictObj( + CONST char *file, + int line) { #ifdef TCL_MEM_DEBUG Tcl_Obj *dictPtr; @@ -1266,7 +1275,7 @@ Tcl_DbNewDictObj(file, line) dict->epoch = 0; dict->chain = NULL; dict->refcount = 1; - dictPtr->internalRep.otherValuePtr = (VOID *) dict; + dictPtr->internalRep.otherValuePtr = (void *) dict; dictPtr->typePtr = &tclDictType; return dictPtr; #else /* !TCL_MEM_DEBUG */ @@ -1281,9 +1290,9 @@ Tcl_DbNewDictObj(file, line) * * DictCreateCmd -- * - * This function implements the "dict create" Tcl command. - * See the user documentation for details on what it does, and - * TIP#111 for the formal specification. + * This function implements the "dict create" Tcl command. See the user + * documentation for details on what it does, and TIP#111 for the formal + * specification. * * Results: * A standard Tcl result. @@ -1295,19 +1304,20 @@ Tcl_DbNewDictObj(file, line) */ static int -DictCreateCmd(interp, objc, objv) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST *objv; +DictCreateCmd( + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST *objv) { Tcl_Obj *dictObj; int i; /* - * Must have an even number of arguments; note that number of - * preceding arguments (i.e. "dict create" is also even, which - * makes this much easier.) + * Must have an even number of arguments; note that number of preceding + * arguments (i.e. "dict create" is also even, which makes this much + * easier.) */ + if (objc & 1) { Tcl_WrongNumArgs(interp, 2, objv, "?key value ...?"); return TCL_ERROR; @@ -1329,9 +1339,9 @@ DictCreateCmd(interp, objc, objv) * * DictGetCmd -- * - * This function implements the "dict get" Tcl command. - * See the user documentation for details on what it does, and - * TIP#111 for the formal specification. + * This function implements the "dict get" Tcl command. See the user + * documentation for details on what it does, and TIP#111 for the formal + * specification. * * Results: * A standard Tcl result. @@ -1343,10 +1353,10 @@ DictCreateCmd(interp, objc, objv) */ static int -DictGetCmd(interp, objc, objv) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST *objv; +DictGetCmd( + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST *objv) { Tcl_Obj *dictPtr, *valuePtr = NULL; int result; @@ -1357,9 +1367,9 @@ DictGetCmd(interp, objc, objv) } /* - * Test for the special case of no keys, which returns a *list* of - * all key,value pairs. We produce a copy here because that makes - * subsequent list handling more efficient. + * Test for the special case of no keys, which returns a *list* of all + * key,value pairs. We produce a copy here because that makes subsequent + * list handling more efficient. */ if (objc == 3) { @@ -1375,8 +1385,8 @@ DictGetCmd(interp, objc, objv) listPtr = Tcl_NewListObj(0, NULL); while (!done) { /* - * Assume these won't fail as we have complete control - * over the types of things here. + * Assume these won't fail as we have complete control over the + * types of things here. */ Tcl_ListObjAppendElement(interp, listPtr, keyPtr); @@ -1389,12 +1399,11 @@ DictGetCmd(interp, objc, objv) } /* - * Loop through the list of keys, looking up the key at the - * current index in the current dictionary each time. Once we've - * done the lookup, we set the current dictionary to be the value - * we looked up (in case the value was not the last one and we are - * going through a chain of searches.) Note that this loop always - * executes at least once. + * Loop through the list of keys, looking up the key at the current index + * in the current dictionary each time. Once we've done the lookup, we set + * the current dictionary to be the value we looked up (in case the value + * was not the last one and we are going through a chain of searches.) + * Note that this loop always executes at least once. */ dictPtr = TclTraceDictPath(interp, objv[2], objc-4,objv+3, DICT_PATH_READ); @@ -1420,9 +1429,9 @@ DictGetCmd(interp, objc, objv) * * DictReplaceCmd -- * - * This function implements the "dict replace" Tcl command. - * See the user documentation for details on what it does, and - * TIP#111 for the formal specification. + * This function implements the "dict replace" Tcl command. See the user + * documentation for details on what it does, and TIP#111 for the formal + * specification. * * Results: * A standard Tcl result. @@ -1434,10 +1443,10 @@ DictGetCmd(interp, objc, objv) */ static int -DictReplaceCmd(interp, objc, objv) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST *objv; +DictReplaceCmd( + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST *objv) { Tcl_Obj *dictPtr; int i, result; @@ -1471,9 +1480,9 @@ DictReplaceCmd(interp, objc, objv) * * DictRemoveCmd -- * - * This function implements the "dict remove" Tcl command. - * See the user documentation for details on what it does, and - * TIP#111 for the formal specification. + * This function implements the "dict remove" Tcl command. See the user + * documentation for details on what it does, and TIP#111 for the formal + * specification. * * Results: * A standard Tcl result. @@ -1485,10 +1494,10 @@ DictReplaceCmd(interp, objc, objv) */ static int -DictRemoveCmd(interp, objc, objv) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST *objv; +DictRemoveCmd( + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST *objv) { Tcl_Obj *dictPtr; int i, result; @@ -1522,9 +1531,9 @@ DictRemoveCmd(interp, objc, objv) * * DictMergeCmd -- * - * This function implements the "dict merge" Tcl command. - * See the user documentation for details on what it does, and - * TIP#163 for the formal specification. + * This function implements the "dict merge" Tcl command. See the user + * documentation for details on what it does, and TIP#163 for the formal + * specification. * * Results: * A standard Tcl result. @@ -1536,10 +1545,10 @@ DictRemoveCmd(interp, objc, objv) */ static int -DictMergeCmd(interp, objc, objv) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST *objv; +DictMergeCmd( + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST *objv) { Tcl_Obj *targetObj, *keyObj, *valueObj; int allocatedDict = 0; @@ -1550,14 +1559,16 @@ DictMergeCmd(interp, objc, objv) /* * No dictionary arguments; return default (empty value). */ + return TCL_OK; } if (objc == 3) { /* - * Single argument, make sure it is a dictionary, but - * otherwise return it. + * Single argument, make sure it is a dictionary, but otherwise return + * it. */ + if (objv[2]->typePtr != &tclDictType) { if (SetDictFromAny(interp, objv[2]) != TCL_OK) { return TCL_ERROR; @@ -1605,9 +1616,9 @@ DictMergeCmd(interp, objc, objv) * * DictKeysCmd -- * - * This function implements the "dict keys" Tcl command. - * See the user documentation for details on what it does, and - * TIP#111 for the formal specification. + * This function implements the "dict keys" Tcl command. See the user + * documentation for details on what it does, and TIP#111 for the formal + * specification. * * Results: * A standard Tcl result. @@ -1619,10 +1630,10 @@ DictMergeCmd(interp, objc, objv) */ static int -DictKeysCmd(interp, objc, objv) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST *objv; +DictKeysCmd( + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST *objv) { Tcl_Obj *keyPtr, *listPtr; Tcl_DictSearch search; @@ -1655,10 +1666,12 @@ DictKeysCmd(interp, objc, objv) /* * Assume this operation always succeeds. */ + Tcl_ListObjAppendElement(interp, listPtr, keyPtr); } } -searchDone: + + searchDone: Tcl_SetObjResult(interp, listPtr); return TCL_OK; } @@ -1668,9 +1681,9 @@ searchDone: * * DictValuesCmd -- * - * This function implements the "dict values" Tcl command. - * See the user documentation for details on what it does, and - * TIP#111 for the formal specification. + * This function implements the "dict values" Tcl command. See the user + * documentation for details on what it does, and TIP#111 for the formal + * specification. * * Results: * A standard Tcl result. @@ -1682,10 +1695,10 @@ searchDone: */ static int -DictValuesCmd(interp, objc, objv) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST *objv; +DictValuesCmd( + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST *objv) { Tcl_Obj *valuePtr, *listPtr; Tcl_DictSearch search; @@ -1710,9 +1723,11 @@ DictValuesCmd(interp, objc, objv) /* * Assume this operation always succeeds. */ + Tcl_ListObjAppendElement(interp, listPtr, valuePtr); } } + Tcl_SetObjResult(interp, listPtr); return TCL_OK; } @@ -1722,9 +1737,9 @@ DictValuesCmd(interp, objc, objv) * * DictSizeCmd -- * - * This function implements the "dict size" Tcl command. - * See the user documentation for details on what it does, and - * TIP#111 for the formal specification. + * This function implements the "dict size" Tcl command. See the user + * documentation for details on what it does, and TIP#111 for the formal + * specification. * * Results: * A standard Tcl result. @@ -1736,10 +1751,10 @@ DictValuesCmd(interp, objc, objv) */ static int -DictSizeCmd(interp, objc, objv) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST *objv; +DictSizeCmd( + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST *objv) { int result, size; @@ -1759,9 +1774,9 @@ DictSizeCmd(interp, objc, objv) * * DictExistsCmd -- * - * This function implements the "dict exists" Tcl command. - * See the user documentation for details on what it does, and - * TIP#111 for the formal specification. + * This function implements the "dict exists" Tcl command. See the user + * documentation for details on what it does, and TIP#111 for the formal + * specification. * * Results: * A standard Tcl result. @@ -1773,10 +1788,10 @@ DictSizeCmd(interp, objc, objv) */ static int -DictExistsCmd(interp, objc, objv) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST *objv; +DictExistsCmd( + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST *objv) { Tcl_Obj *dictPtr, *valuePtr; int result; @@ -1808,9 +1823,9 @@ DictExistsCmd(interp, objc, objv) * * DictInfoCmd -- * - * This function implements the "dict info" Tcl command. - * See the user documentation for details on what it does, and - * TIP#111 for the formal specification. + * This function implements the "dict info" Tcl command. See the user + * documentation for details on what it does, and TIP#111 for the formal + * specification. * * Results: * A standard Tcl result. @@ -1822,10 +1837,10 @@ DictExistsCmd(interp, objc, objv) */ static int -DictInfoCmd(interp, objc, objv) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST *objv; +DictInfoCmd( + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST *objv) { Tcl_Obj *dictPtr; Dict *dict; @@ -1846,6 +1861,7 @@ DictInfoCmd(interp, objc, objv) /* * This next cast is actually OK. */ + Tcl_SetResult(interp, (char *)Tcl_HashStats(&dict->table), TCL_DYNAMIC); return TCL_OK; } @@ -1855,9 +1871,9 @@ DictInfoCmd(interp, objc, objv) * * DictIncrCmd -- * - * This function implements the "dict incr" Tcl command. - * See the user documentation for details on what it does, and - * TIP#111 for the formal specification. + * This function implements the "dict incr" Tcl command. See the user + * documentation for details on what it does, and TIP#111 for the formal + * specification. * * Results: * A standard Tcl result. @@ -1869,10 +1885,10 @@ DictInfoCmd(interp, objc, objv) */ static int -DictIncrCmd(interp, objc, objv) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST *objv; +DictIncrCmd( + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST *objv) { int code = TCL_OK; Tcl_Obj *dictPtr, *valuePtr = NULL; @@ -1884,25 +1900,42 @@ DictIncrCmd(interp, objc, objv) dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0); if (dictPtr == NULL) { - /* Variable didn't yet exist. Create new dictionary value */ + /* + * Variable didn't yet exist. Create new dictionary value. + */ + dictPtr = Tcl_NewDictObj(); } else if (Tcl_DictObjGet(interp, dictPtr, objv[3], &valuePtr) != TCL_OK) { - /* Variable contents are not a dict, report error */ + /* + * Variable contents are not a dict, report error. + */ + return TCL_ERROR; } if (Tcl_IsShared(dictPtr)) { - /* A little internals surgery to avoid copying a string rep - * that will soon be no good */ + /* + * A little internals surgery to avoid copying a string rep that will + * soon be no good. + */ + char *saved = dictPtr->bytes; + dictPtr->bytes = NULL; dictPtr = Tcl_DuplicateObj(dictPtr); dictPtr->bytes = saved; } if (valuePtr == NULL) { - /* Key not in dictionary. Create new key with increment as value */ + /* + * Key not in dictionary. Create new key with increment as value. + */ + if (objc == 5) { - /* Verify increment is an integer */ + /* + * Verify increment is an integer. + */ + mp_int increment; + code = Tcl_GetBignumFromObj(interp, objv[4], &increment); if (code != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (reading increment)"); @@ -1913,7 +1946,10 @@ DictIncrCmd(interp, objc, objv) Tcl_DictObjPut(interp, dictPtr, objv[3], Tcl_NewIntObj(1)); } } else { - /* Key in dictionary. Increment its value with minimum dup. */ + /* + * Key in dictionary. Increment its value with minimum dup. + */ + if (Tcl_IsShared(valuePtr)) { valuePtr = Tcl_DuplicateObj(valuePtr); Tcl_DictObjPut(interp, dictPtr, objv[3], valuePtr); @@ -1948,9 +1984,9 @@ DictIncrCmd(interp, objc, objv) * * DictLappendCmd -- * - * This function implements the "dict lappend" Tcl command. - * See the user documentation for details on what it does, and - * TIP#111 for the formal specification. + * This function implements the "dict lappend" Tcl command. See the user + * documentation for details on what it does, and TIP#111 for the formal + * specification. * * Results: * A standard Tcl result. @@ -1962,10 +1998,10 @@ DictIncrCmd(interp, objc, objv) */ static int -DictLappendCmd(interp, objc, objv) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST *objv; +DictLappendCmd( + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST *objv) { Tcl_Obj *dictPtr, *valuePtr, *resultPtr; int i, allocatedDict = 0, allocatedValue = 0; @@ -2036,9 +2072,9 @@ DictLappendCmd(interp, objc, objv) * * DictAppendCmd -- * - * This function implements the "dict append" Tcl command. - * See the user documentation for details on what it does, and - * TIP#111 for the formal specification. + * This function implements the "dict append" Tcl command. See the user + * documentation for details on what it does, and TIP#111 for the formal + * specification. * * Results: * A standard Tcl result. @@ -2050,10 +2086,10 @@ DictLappendCmd(interp, objc, objv) */ static int -DictAppendCmd(interp, objc, objv) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST *objv; +DictAppendCmd( + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST *objv) { Tcl_Obj *dictPtr, *valuePtr, *resultPtr; int i, allocatedDict = 0; @@ -2109,9 +2145,9 @@ DictAppendCmd(interp, objc, objv) * * 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 specification. + * 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. * * Results: * A standard Tcl result. @@ -2123,10 +2159,10 @@ DictAppendCmd(interp, objc, objv) */ static int -DictForCmd(interp, objc, objv) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST *objv; +DictForCmd( + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST *objv) { Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj; Tcl_Obj **varv, *keyObj, *valueObj; @@ -2150,11 +2186,13 @@ DictForCmd(interp, objc, objv) keyVarObj = varv[0]; valueVarObj = varv[1]; scriptObj = objv[4]; + /* * 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 + * loop) don't vanish. Note that the dictionary internal rep is locked * internally so that updates, shimmering, etc are not a problem. */ + Tcl_IncrRefCount(keyVarObj); Tcl_IncrRefCount(valueVarObj); Tcl_IncrRefCount(scriptObj); @@ -2167,14 +2205,15 @@ DictForCmd(interp, objc, objv) while (!done) { /* - * Stop the value from getting hit in any way by any traces on - * the key variable. + * 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, 0) == NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't set key variable: \"", - TclGetString(keyVarObj), "\"", (char *) NULL); + TclGetString(keyVarObj), "\"", NULL); TclDecrRefCount(valueObj); result = TCL_ERROR; goto doneFor; @@ -2183,7 +2222,7 @@ DictForCmd(interp, objc, objv) if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, 0) == NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't set value variable: \"", - TclGetString(valueVarObj), "\"", (char *) NULL); + TclGetString(valueVarObj), "\"", NULL); result = TCL_ERROR; goto doneFor; } @@ -2208,6 +2247,7 @@ DictForCmd(interp, objc, objv) /* * Stop holding a reference to these objects. */ + TclDecrRefCount(keyVarObj); TclDecrRefCount(valueVarObj); TclDecrRefCount(scriptObj); @@ -2224,9 +2264,9 @@ DictForCmd(interp, objc, objv) * * DictSetCmd -- * - * This function implements the "dict set" Tcl command. - * See the user documentation for details on what it does, and - * TIP#111 for the formal specification. + * This function implements the "dict set" Tcl command. See the user + * documentation for details on what it does, and TIP#111 for the formal + * specification. * * Results: * A standard Tcl result. @@ -2238,10 +2278,10 @@ DictForCmd(interp, objc, objv) */ static int -DictSetCmd(interp, objc, objv) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST *objv; +DictSetCmd( + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST *objv) { Tcl_Obj *dictPtr, *resultPtr; int result, allocatedDict = 0; @@ -2285,9 +2325,9 @@ DictSetCmd(interp, objc, objv) * * DictUnsetCmd -- * - * This function implements the "dict unset" Tcl command. - * See the user documentation for details on what it does, and - * TIP#111 for the formal specification. + * This function implements the "dict unset" Tcl command. See the user + * documentation for details on what it does, and TIP#111 for the formal + * specification. * * Results: * A standard Tcl result. @@ -2299,10 +2339,10 @@ DictSetCmd(interp, objc, objv) */ static int -DictUnsetCmd(interp, objc, objv) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST *objv; +DictUnsetCmd( + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST *objv) { Tcl_Obj *dictPtr, *resultPtr; int result, allocatedDict = 0; @@ -2345,9 +2385,9 @@ DictUnsetCmd(interp, objc, objv) * * DictFilterCmd -- * - * This function implements the "dict filter" Tcl command. - * See the user documentation for details on what it does, and - * TIP#111 for the formal specification. + * This function implements the "dict filter" Tcl command. See the user + * documentation for details on what it does, and TIP#111 for the formal + * specification. * * Results: * A standard Tcl result. @@ -2359,10 +2399,10 @@ DictUnsetCmd(interp, objc, objv) */ static int -DictFilterCmd(interp, objc, objv) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST *objv; +DictFilterCmd( + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST *objv) { static CONST char *filters[] = { "key", "script", "value", NULL @@ -2395,6 +2435,7 @@ DictFilterCmd(interp, objc, objv) /* * Create a dictionary whose keys all match a certain pattern. */ + if (Tcl_DictObjFirst(interp, objv[2], &search, &keyObj, &valueObj, &done) != TCL_OK) { return TCL_ERROR; @@ -2426,6 +2467,7 @@ DictFilterCmd(interp, objc, objv) /* * Create a dictionary whose values all match a certain pattern. */ + if (Tcl_DictObjFirst(interp, objv[2], &search, &keyObj, &valueObj, &done) != TCL_OK) { return TCL_ERROR; @@ -2449,10 +2491,9 @@ DictFilterCmd(interp, objc, objv) } /* - * Create a dictionary whose key,value pairs all satisfy a - * script (i.e. get a true boolean result from its - * evaluation.) Massive copying from the "dict for" - * implementation has occurred! + * Create a dictionary whose key,value pairs all satisfy a script + * (i.e. get a true boolean result from its evaluation). Massive + * copying from the "dict for" implementation has occurred! */ if (Tcl_ListObjGetElements(interp, objv[4], &varc, &varv) != TCL_OK) { @@ -2466,12 +2507,14 @@ DictFilterCmd(interp, objc, objv) keyVarObj = varv[0]; valueVarObj = varv[1]; scriptObj = objv[5]; + /* * Make sure that these objects (which we need throughout the body of - * the loop) don't vanish. Note that the dictionary internal rep is + * 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(keyVarObj); Tcl_IncrRefCount(valueVarObj); Tcl_IncrRefCount(scriptObj); @@ -2489,16 +2532,17 @@ DictFilterCmd(interp, objc, objv) while (!done) { /* - * Stop the value from getting hit in any way by any - * traces on the key variable. + * Stop the value from getting hit in any way by any traces on the + * key variable. */ + Tcl_IncrRefCount(keyObj); Tcl_IncrRefCount(valueObj); if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, TCL_LEAVE_ERR_MSG) == NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't set key variable: \"", - TclGetString(keyVarObj), "\"", (char *) NULL); + TclGetString(keyVarObj), "\"", NULL); result = TCL_ERROR; goto abnormalResult; } @@ -2506,7 +2550,7 @@ DictFilterCmd(interp, objc, objv) TCL_LEAVE_ERR_MSG) == NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't set value variable: \"", - TclGetString(valueVarObj), "\"", (char *) NULL); + TclGetString(valueVarObj), "\"", NULL); goto abnormalResult; } @@ -2533,6 +2577,7 @@ DictFilterCmd(interp, objc, objv) * makes the next Tcl_DictObjNext say there is nothing more to * do. */ + Tcl_ResetResult(interp); Tcl_DictObjDone(&search); case TCL_CONTINUE: @@ -2555,6 +2600,7 @@ DictFilterCmd(interp, objc, objv) /* * Stop holding a reference to these objects. */ + TclDecrRefCount(keyVarObj); TclDecrRefCount(valueVarObj); TclDecrRefCount(scriptObj); @@ -2566,6 +2612,7 @@ DictFilterCmd(interp, objc, objv) TclDecrRefCount(resultObj); } return result; + abnormalResult: Tcl_DictObjDone(&search); TclDecrRefCount(keyObj); @@ -2586,9 +2633,9 @@ DictFilterCmd(interp, objc, objv) * * DictUpdateCmd -- * - * This function implements the "dict update" Tcl command. - * See the user documentation for details on what it does, and - * TIP#212 for the formal specification. + * This function implements the "dict update" Tcl command. See the user + * documentation for details on what it does, and TIP#212 for the formal + * specification. * * Results: * A standard Tcl result. @@ -2600,10 +2647,10 @@ DictFilterCmd(interp, objc, objv) */ static int -DictUpdateCmd(interp, objc, objv) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST *objv; +DictUpdateCmd( + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST *objv) { Tcl_Obj *dictPtr, *objPtr; int i, result, dummy, allocdict = 0; @@ -2649,8 +2696,7 @@ DictUpdateCmd(interp, objc, objv) } /* - * If the dictionary variable doesn't exist, drop everything - * silently. + * If the dictionary variable doesn't exist, drop everything silently. */ dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0); @@ -2674,8 +2720,8 @@ DictUpdateCmd(interp, objc, objv) } /* - * Write back the values from the variables, treating failure to - * read as an instruction to remove the key. + * Write back the values from the variables, treating failure to read as + * an instruction to remove the key. */ for (i=3 ; i+2<objc ; i+=2) { @@ -2709,9 +2755,9 @@ DictUpdateCmd(interp, objc, objv) * * DictWithCmd -- * - * This function implements the "dict with" Tcl command. - * See the user documentation for details on what it does, and - * TIP#212 for the formal specification. + * This function implements the "dict with" Tcl command. See the user + * documentation for details on what it does, and TIP#212 for the formal + * specification. * * Results: * A standard Tcl result. @@ -2723,10 +2769,10 @@ DictUpdateCmd(interp, objc, objv) */ static int -DictWithCmd(interp, objc, objv) - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST *objv; +DictWithCmd( + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST *objv) { Tcl_Obj *dictPtr, *keysPtr, *keyPtr, *valPtr, **keyv, *leafPtr; Tcl_DictSearch s; @@ -2755,10 +2801,10 @@ DictWithCmd(interp, objc, objv) } /* - * Go over the list of keys and write each corresponding value to - * a variable in the current context with the same name. Also - * keep a copy of the keys so we can write back properly later on - * even if the dictionary has been structurally modified. + * Go over the list of keys and write each corresponding value to a + * variable in the current context with the same name. Also keep a copy of + * the keys so we can write back properly later on even if the dictionary + * has been structurally modified. */ if (Tcl_DictObjFirst(interp, dictPtr, &s, &keyPtr, &valPtr, @@ -2789,8 +2835,7 @@ DictWithCmd(interp, objc, objv) } /* - * If the dictionary variable doesn't exist, drop everything - * silently. + * If the dictionary variable doesn't exist, drop everything silently. */ dictPtr = Tcl_ObjGetVar2(interp, objv[2], NULL, 0); @@ -2817,14 +2862,14 @@ DictWithCmd(interp, objc, objv) if (objc > 4) { /* - * Want to get to the dictionary which we will update; need to - * do prepare-for-update de-sharing along the path *but* avoid - * generating an error on a non-existant path (we'll treat - * that the same as a non-existant variable. Luckily, the - * de-sharing operation isn't deeply damaging if we don't go - * on to update; it's just less than perfectly efficient (but - * no memory should be leaked). + * Want to get to the dictionary which we will update; need to do + * prepare-for-update de-sharing along the path *but* avoid generating + * an error on a non-existant path (we'll treat that the same as a + * non-existant variable. Luckily, the de-sharing operation isn't + * deeply damaging if we don't go on to update; it's just less than + * perfectly efficient (but no memory should be leaked). */ + leafPtr = TclTraceDictPath(interp, dictPtr, objc-4, objv+3, DICT_PATH_EXISTS | DICT_PATH_UPDATE); if (leafPtr == NULL) { @@ -2862,8 +2907,8 @@ DictWithCmd(interp, objc, objv) TclDecrRefCount(keysPtr); /* - * Ensure that none of the dictionaries in the chain still have a - * string rep. + * Ensure that none of the dictionaries in the chain still have a string + * rep. */ if (objc > 4) { @@ -2890,9 +2935,9 @@ DictWithCmd(interp, objc, objv) * * Tcl_DictObjCmd -- * - * This function is invoked to process the "dict" Tcl command. - * See the user documentation for details on what it does, and - * TIP#111 for the formal specification. + * This function is invoked to process the "dict" Tcl command. See the + * user documentation for details on what it does, and TIP#111 for the + * formal specification. * * Results: * A standard Tcl result. @@ -2904,11 +2949,11 @@ DictWithCmd(interp, objc, objv) */ int -Tcl_DictObjCmd(/*ignored*/ clientData, interp, objc, objv) - ClientData clientData; - Tcl_Interp *interp; - int objc; - Tcl_Obj *CONST *objv; +Tcl_DictObjCmd( + /*ignored*/ ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST *objv) { static CONST char *subcommands[] = { "append", "create", "exists", "filter", "for", @@ -2954,8 +2999,18 @@ Tcl_DictObjCmd(/*ignored*/ clientData, interp, objc, objv) case DICT_WITH: return DictWithCmd(interp, objc, objv); } Tcl_Panic("unexpected fallthrough!"); + /* * Next line is NOT REACHED - stops compliler complaint though... */ + return TCL_ERROR; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |