diff options
author | sebres <sebres@users.sourceforge.net> | 2017-05-29 20:23:56 (GMT) |
---|---|---|
committer | sebres <sebres@users.sourceforge.net> | 2017-05-29 20:23:56 (GMT) |
commit | 3feeaaf027b3a7cc8332f64b0c0e39769edb4163 (patch) | |
tree | 4e2d3a4cf9aac23952c495090e7a73a55532f882 /generic/tclDictObj.c | |
parent | 3ae95af52ca24414d723b827fc99cc1a2b94f778 (diff) | |
parent | 887b450f7e64e2426a51e06246cb9295b126932c (diff) | |
download | tcl-3feeaaf027b3a7cc8332f64b0c0e39769edb4163.zip tcl-3feeaaf027b3a7cc8332f64b0c0e39769edb4163.tar.gz tcl-3feeaaf027b3a7cc8332f64b0c0e39769edb4163.tar.bz2 |
merge sebres-8-6-clock-speedup (clock speed-up / flightaware Tcl-bounties#4, see RFE [ddc948cff9781daac7ad95a3077b3c1b4f07cf93])
Diffstat (limited to 'generic/tclDictObj.c')
-rw-r--r-- | generic/tclDictObj.c | 117 |
1 files changed, 107 insertions, 10 deletions
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 428173d..593f5a3 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -51,6 +51,8 @@ static int DictSetCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictSizeCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); +static int DictSmartRefCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const *objv); static int DictUnsetCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int DictUpdateCmd(ClientData dummy, Tcl_Interp *interp, @@ -98,6 +100,7 @@ static const EnsembleImplMap implementationMap[] = { {"replace", DictReplaceCmd, NULL, NULL, NULL, 0 }, {"set", DictSetCmd, TclCompileDictSetCmd, NULL, NULL, 0 }, {"size", DictSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0 }, + {"smartref",DictSmartRefCmd,NULL, NULL, NULL, 0 }, {"unset", DictUnsetCmd, TclCompileDictUnsetCmd, NULL, NULL, 0 }, {"update", DictUpdateCmd, TclCompileDictUpdateCmd, NULL, NULL, 0 }, {"values", DictValuesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, @@ -142,7 +145,7 @@ typedef struct Dict { * the entries in the order that they are * created. */ int epoch; /* Epoch counter */ - int refcount; /* Reference counter (see above) */ + size_t refCount; /* Reference counter (see above) */ Tcl_Obj *chain; /* Linked list used for invalidating the * string representations of updated nested * dictionaries. */ @@ -392,7 +395,7 @@ DupDictInternalRep( newDict->epoch = 0; newDict->chain = NULL; - newDict->refcount = 1; + newDict->refCount = 1; /* * Store in the object. @@ -427,8 +430,7 @@ FreeDictInternalRep( { Dict *dict = DICT(dictPtr); - dict->refcount--; - if (dict->refcount <= 0) { + if (dict->refCount-- <= 1) { DeleteDict(dict); } dictPtr->typePtr = NULL; @@ -713,7 +715,7 @@ SetDictFromAny( TclFreeIntRep(objPtr); dict->epoch = 0; dict->chain = NULL; - dict->refcount = 1; + dict->refCount = 1; DICT(objPtr) = dict; objPtr->internalRep.twoPtrValue.ptr2 = NULL; objPtr->typePtr = &tclDictType; @@ -1117,7 +1119,7 @@ Tcl_DictObjFirst( searchPtr->dictionaryPtr = (Tcl_Dict) dict; searchPtr->epoch = dict->epoch; searchPtr->next = cPtr->nextPtr; - dict->refcount++; + dict->refCount++; if (keyPtrPtr != NULL) { *keyPtrPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry); } @@ -1231,8 +1233,7 @@ Tcl_DictObjDone( if (searchPtr->epoch != -1) { searchPtr->epoch = -1; dict = (Dict *) searchPtr->dictionaryPtr; - dict->refcount--; - if (dict->refcount <= 0) { + if (dict->refCount-- <= 1) { DeleteDict(dict); } } @@ -1384,7 +1385,7 @@ Tcl_NewDictObj(void) InitChainTable(dict); dict->epoch = 0; dict->chain = NULL; - dict->refcount = 1; + dict->refCount = 1; DICT(dictPtr) = dict; dictPtr->internalRep.twoPtrValue.ptr2 = NULL; dictPtr->typePtr = &tclDictType; @@ -1434,7 +1435,7 @@ Tcl_DbNewDictObj( InitChainTable(dict); dict->epoch = 0; dict->chain = NULL; - dict->refcount = 1; + dict->refCount = 1; DICT(dictPtr) = dict; dictPtr->internalRep.twoPtrValue.ptr2 = NULL; dictPtr->typePtr = &tclDictType; @@ -1960,6 +1961,102 @@ DictSizeCmd( /* *---------------------------------------------------------------------- * + * Tcl_DictObjSmartRef -- + * + * This function returns new tcl-object with the smart reference to + * dictionary object. + * + * Object returned with this function is a smart reference (pointer), + * so new object of type tclDictType, that directly references given + * dictionary object (with internally increased refCount). + * + * The usage of such pointer objects allows to hold more as one + * reference to the same real dictionary object, allows to make a pointer + * to part of another dictionary, allows to change the dictionary without + * regarding of the "shared" state of the dictionary object. + * + * Prevents "called with shared object" exception if object is multiple + * referenced. + * + * Results: + * The newly create object (contains smart reference) is returned. + * The returned object has a ref count of 0. + * + * Side effects: + * Increases ref count of the referenced dictionary. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +Tcl_DictObjSmartRef( + Tcl_Interp *interp, + Tcl_Obj *dictPtr) +{ + Tcl_Obj *result; + Dict *dict; + + if (dictPtr->typePtr != &tclDictType + && SetDictFromAny(interp, dictPtr) != TCL_OK) { + return NULL; + } + + dict = DICT(dictPtr); + + result = Tcl_NewObj(); + DICT(result) = dict; + dict->refCount++; + result->internalRep.twoPtrValue.ptr2 = NULL; + result->typePtr = &tclDictType; + + return result; +} + +/* + *---------------------------------------------------------------------- + * + * DictSmartRefCmd -- + * + * This function implements the "dict smartref" Tcl command. + * + * See description of Tcl_DictObjSmartRef for details. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +DictSmartRefCmd( + ClientData dummy, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const *objv) +{ + Tcl_Obj *result; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "dictionary"); + return TCL_ERROR; + } + + result = Tcl_DictObjSmartRef(interp, objv[1]); + if (result == NULL) { + return TCL_ERROR; + } + + Tcl_SetObjResult(interp, result); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * DictExistsCmd -- * * This function implements the "dict exists" Tcl command. See the user |