diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tcl.h | 9 | ||||
| -rw-r--r-- | generic/tclDictObj.c | 208 |
2 files changed, 141 insertions, 76 deletions
diff --git a/generic/tcl.h b/generic/tcl.h index a697ade..4a285d0 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tcl.h,v 1.183 2004/09/10 19:54:06 andreas_kupries Exp $ + * RCS: @(#) $Id: tcl.h,v 1.184 2004/10/02 17:00:38 dkf Exp $ */ #ifndef _TCL @@ -1339,9 +1339,10 @@ typedef struct Tcl_HashSearch { */ typedef struct { - Tcl_HashSearch search; - int epoch; - Tcl_Dict dictionaryPtr; + Tcl_HashSearch search; /* Search struct for underlying hash table. */ + int epoch; /* Epoch marker for dictionary being searched, + * or -1 if search has terminated. */ + Tcl_Dict dictionaryPtr; /* Reference to dictionary being searched. */ } Tcl_DictSearch; diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 327fb92..046a6de 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -9,14 +9,22 @@ * 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.18 2004/09/29 22:17:31 dkf Exp $ + * RCS: @(#) $Id: tclDictObj.c,v 1.19 2004/10/02 17:00:39 dkf Exp $ */ #include "tclInt.h" /* + * Forward declaration. + */ +struct Dict; + +/* * Flag values for TraceDictPath(). * + * DICT_PATH_READ indicates that all entries on the path must exist + * but no updates will be needed. + * * DICT_PATH_UPDATE indicates that we are going to be doing an update * at the tip of the path, so duplication of shared objects should be * done along the way. @@ -25,10 +33,16 @@ * and a lookup failure should therefore not be an error. If (and * only if) this flag is set, TraceDictPath() will return the special * value DICT_PATH_NON_EXISTENT if the path is not traceable. + * + * DICT_PATH_CREATE (which also requires the DICT_PATH_UPDATE bit to + * be set) indicates that we are to create non-existant dictionaries + * on the path. */ +#define DICT_PATH_READ 0 #define DICT_PATH_UPDATE 1 #define DICT_PATH_EXISTS 2 +#define DICT_PATH_CREATE 5 #define DICT_PATH_NON_EXISTENT ((Tcl_Obj *) (void *) 1) @@ -36,6 +50,7 @@ * Prototypes for procedures 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, @@ -76,12 +91,10 @@ 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 Tcl_Obj * TraceDictPath _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *rootPtr, int keyc, Tcl_Obj *CONST keyv[], int flags)); -struct Dict; -static void DeleteDict _ANSI_ARGS_((struct Dict *dict)); +static void UpdateStringOfDict _ANSI_ARGS_((Tcl_Obj *dictPtr)); /* * Internal representation of a dictionary. @@ -192,11 +205,11 @@ DupDictInternalRep(srcPtr, copyPtr) * None * * Side effects: - * Frees the memory holding the dictionary's internal hash table. - * Decrements the reference count of all key and value objects, - * which may free them. + * Frees the memory holding the dictionary's internal hash table + * unless it is locked by an iteration going over it. * *---------------------------------------------------------------------- + */ static void @@ -213,6 +226,26 @@ FreeDictInternalRep(dictPtr) dictPtr->internalRep.otherValuePtr = NULL; /* Belt and braces! */ } +/* + *---------------------------------------------------------------------- + * + * 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. + * + * Results: + * None + * + * Side effects: + * Decrements the reference count of all key and value objects in + * the dictionary, which may free them. + * + *---------------------------------------------------------------------- + */ + static void DeleteDict(dict) Dict *dict; @@ -554,16 +587,17 @@ SetDictFromAny(interp, objPtr) * TraceDictPath -- * * Trace through a tree of dictionaries using the array of keys - * given. If the willUpdate 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.) + * 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 is DICT_PATH_EXISTS, - * 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 @@ -572,8 +606,11 @@ SetDictFromAny(interp, objPtr) * 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.) + * 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. * *---------------------------------------------------------------------- */ @@ -593,7 +630,7 @@ TraceDictPath(interp, dictPtr, keyc, keyv, flags) } } dict = (Dict *) dictPtr->internalRep.otherValuePtr; - if (flags == DICT_PATH_UPDATE) { + if (flags & DICT_PATH_UPDATE) { dict->chain = NULL; } @@ -602,26 +639,38 @@ TraceDictPath(interp, dictPtr, keyc, keyv, flags) Tcl_Obj *tmpObj; if (hPtr == NULL) { - if (flags == DICT_PATH_EXISTS) { + int isNew; /* Dummy */ + if (flags & DICT_PATH_EXISTS) { return DICT_PATH_NON_EXISTENT; } - if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "key \"", TclGetString(keyv[i]), - "\" not known in dictionary", NULL); + if ((flags & DICT_PATH_CREATE) != DICT_PATH_CREATE) { + if (interp != NULL) { + Tcl_ResetResult(interp); + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "key \"", TclGetString(keyv[i]), + "\" not known in dictionary", NULL); + } + return NULL; } - return NULL; - } - tmpObj = (Tcl_Obj *) Tcl_GetHashValue(hPtr); - if (tmpObj->typePtr != &tclDictType) { - if (SetDictFromAny(interp, tmpObj) != TCL_OK) { - return NULL; + /* + * The next line should always set isNew to 1. + */ + hPtr = Tcl_CreateHashEntry(&dict->table, (char *)keyv[i], &isNew); + tmpObj = Tcl_NewDictObj(); + Tcl_IncrRefCount(tmpObj); + Tcl_SetHashValue(hPtr, (ClientData) tmpObj); + } else { + tmpObj = (Tcl_Obj *) Tcl_GetHashValue(hPtr); + if (tmpObj->typePtr != &tclDictType) { + if (SetDictFromAny(interp, tmpObj) != TCL_OK) { + return NULL; + } } } + newDict = (Dict *) tmpObj->internalRep.otherValuePtr; - if (flags == DICT_PATH_UPDATE) { + if (flags & DICT_PATH_UPDATE) { if (Tcl_IsShared(tmpObj)) { Tcl_DecrRefCount(tmpObj); tmpObj = Tcl_DuplicateObj(tmpObj); @@ -638,6 +687,27 @@ TraceDictPath(interp, dictPtr, keyc, keyv, flags) } return dictPtr; } + +/* + *---------------------------------------------------------------------- + * + * InvalidateDictChain -- + * + * Go through a dictionary chain (built by an updating invokation + * of TraceDictPath) 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. + * + *---------------------------------------------------------------------- + */ + static void InvalidateDictChain(dictObj) Tcl_Obj *dictObj; @@ -645,11 +715,10 @@ InvalidateDictChain(dictObj) Dict *dict = (Dict *) dictObj->internalRep.otherValuePtr; do { - if (dictObj->bytes != NULL) { - Tcl_InvalidateStringRep(dictObj); - } + Tcl_InvalidateStringRep(dictObj); dict->epoch++; - if ((dictObj = dict->chain) == NULL) { + dictObj = dict->chain; + if (dictObj == NULL) { break; } dict->chain = NULL; @@ -901,6 +970,7 @@ Tcl_DictObjFirst(interp, dictPtr, searchPtr, keyPtrPtr, valuePtrPtr, donePtr) dict = (Dict *) dictPtr->internalRep.otherValuePtr; hPtr = Tcl_FirstHashEntry(&dict->table, &searchPtr->search); if (hPtr == NULL) { + searchPtr->epoch = -1; *donePtr = 1; } else { *donePtr = 0; @@ -957,6 +1027,14 @@ Tcl_DictObjNext(searchPtr, keyPtrPtr, valuePtrPtr, donePtr) 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... */ @@ -1054,7 +1132,7 @@ Tcl_DictObjPutKeyList(interp, dictPtr, keyc, keyv, valuePtr) Tcl_Panic("Tcl_DictObjPutKeyList called with empty key list"); } - dictPtr = TraceDictPath(interp, dictPtr, keyc-1, keyv, DICT_PATH_UPDATE); + dictPtr = TraceDictPath(interp, dictPtr, keyc-1, keyv, DICT_PATH_CREATE); if (dictPtr == NULL) { return TCL_ERROR; } @@ -1344,7 +1422,7 @@ DictGetCmd(interp, objc, objv) * going through a chain of searches.) Note that this loop always * executes at least once. */ - dictPtr = TraceDictPath(interp, objv[2], objc-4, objv+3, 0); + dictPtr = TraceDictPath(interp, objv[2], objc-4, objv+3, DICT_PATH_READ); if (dictPtr == NULL) { return TCL_ERROR; } @@ -2181,7 +2259,6 @@ DictForCmd(interp, objc, objv) return TCL_ERROR; } if (varc != 2) { - Tcl_ResetResult(interp); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "must have exactly two variable names", NULL); return TCL_ERROR; @@ -2207,11 +2284,7 @@ DictForCmd(interp, objc, objv) result = Tcl_DictObjFirst(interp, dictObj, &search, &keyObj, &valueObj, &done); if (result != TCL_OK) { - Tcl_DecrRefCount(keyVarObj); - Tcl_DecrRefCount(valueVarObj); - Tcl_DecrRefCount(dictObj); - Tcl_DecrRefCount(scriptObj); - return TCL_ERROR; + goto doneFor; } while (!done) { @@ -2220,56 +2293,45 @@ DictForCmd(interp, objc, objv) * the key variable. */ Tcl_IncrRefCount(valueObj); - if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, - TCL_LEAVE_ERR_MSG) == NULL) { + if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, 0) == NULL) { Tcl_ResetResult(interp); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "couldn't set key variable: \"", - Tcl_GetString(keyVarObj), "\"", (char *) NULL); + TclGetString(keyVarObj), "\"", (char *) NULL); Tcl_DecrRefCount(valueObj); - errorExit: - Tcl_DictObjDone(&search); - Tcl_DecrRefCount(keyVarObj); - Tcl_DecrRefCount(valueVarObj); - Tcl_DecrRefCount(dictObj); - Tcl_DecrRefCount(scriptObj); - return TCL_ERROR; + result = TCL_ERROR; + goto doneFor; } Tcl_DecrRefCount(valueObj); - if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, - TCL_LEAVE_ERR_MSG) == NULL) { + if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, 0) == NULL) { Tcl_ResetResult(interp); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "couldn't set value variable: \"", - Tcl_GetString(keyVarObj), "\"", (char *) NULL); - goto errorExit; + TclGetString(valueVarObj), "\"", (char *) NULL); + result = TCL_ERROR; + goto doneFor; } result = Tcl_EvalObjEx(interp, scriptObj, 0); - if (result != TCL_OK) { - if (result == TCL_CONTINUE) { - result = TCL_OK; - } else if (result == TCL_BREAK) { + if (result == TCL_CONTINUE) { + result = TCL_OK; + } else if (result != TCL_OK) { + if (result == TCL_BREAK) { result = TCL_OK; - Tcl_DictObjDone(&search); - break; } else if (result == TCL_ERROR) { - char msg[32 + TCL_INTEGER_SPACE]; + char msg[32 + TCL_INTEGER_SPACE]; sprintf(msg, "\n (\"dict for\" body line %d)", interp->errorLine); Tcl_AddObjErrorInfo(interp, msg, -1); - Tcl_DictObjDone(&search); - break; - } else { - Tcl_DictObjDone(&search); - break; } + break; } Tcl_DictObjNext(&search, &keyObj, &valueObj, &done); } + doneFor: /* * Stop holding a reference to these objects. */ @@ -2278,6 +2340,7 @@ DictForCmd(interp, objc, objv) Tcl_DecrRefCount(dictObj); Tcl_DecrRefCount(scriptObj); + Tcl_DictObjDone(&search); if (result == TCL_OK) { Tcl_ResetResult(interp); } @@ -2565,7 +2628,7 @@ DictFilterCmd(interp, objc, objv) Tcl_ResetResult(interp); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "couldn't set key variable: \"", - Tcl_GetString(keyVarObj), "\"", (char *) NULL); + TclGetString(keyVarObj), "\"", (char *) NULL); result = TCL_ERROR; goto abnormalResult; } @@ -2574,7 +2637,7 @@ DictFilterCmd(interp, objc, objv) Tcl_ResetResult(interp); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "couldn't set value variable: \"", - Tcl_GetString(keyVarObj), "\"", (char *) NULL); + TclGetString(valueVarObj), "\"", (char *) NULL); goto abnormalResult; } @@ -2605,7 +2668,7 @@ DictFilterCmd(interp, objc, objv) Tcl_ResetResult(interp); Tcl_DictObjDone(&search); result = TCL_OK; - goto normalResult; + break; case TCL_ERROR: sprintf(msg, "\n (\"dict filter\" script line %d)", interp->errorLine); @@ -2628,6 +2691,7 @@ DictFilterCmd(interp, objc, objv) Tcl_DecrRefCount(valueVarObj); Tcl_DecrRefCount(dictObj); Tcl_DecrRefCount(scriptObj); + Tcl_DictObjDone(&search); if (result == TCL_OK) { Tcl_SetObjResult(interp, resultObj); |