From aafa141509243b40b852ef16b1810de96659d658 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Sat, 13 May 2023 10:59:32 +0000 Subject: Add TclRelaxRefCount, and also try to take the fast path more often in byte-compiled [lindex]. --- generic/tclDictObj.c | 20 ++++++++++++++++++++ generic/tclExecute.c | 40 +++++++++++++++++++++++++++++----------- generic/tclInt.h | 6 ++++++ generic/tclListObj.c | 23 +++++++++++++++++++++++ generic/tclObj.c | 24 +++++++++++++++++++++++- 5 files changed, 101 insertions(+), 12 deletions(-) diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index f996f4b..c4ff0fa 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -1048,6 +1048,26 @@ Tcl_DictObjRemove( /* *---------------------------------------------------------------------- * + * Tcl_DictGetSize + * + * Returns the size of dictPtr. Caller must ensure that dictPtr has type + * 'tclDicttype'. + * + * + *---------------------------------------------------------------------- + */ + +Tcl_Size +TclDictGetSize(Tcl_Obj *dictPtr) +{ + Dict *dict; + DictGetInternalRep(dictPtr, dict); + return dict->table.numEntries; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_DictObjSize -- * * How many key,value pairs are there in the dictionary? diff --git a/generic/tclExecute.c b/generic/tclExecute.c index a1b387a..49f3e8f 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -4682,22 +4682,40 @@ TEBCresume( * Extract the desired list element. */ - if ((TclListObjGetElementsM(interp, valuePtr, &objc, &objv) == TCL_OK) - && !TclHasInternalRep(value2Ptr, &tclListType.objType)) { - int code; + { + Tcl_Size value2Length; + if ((TclListObjGetElementsM(interp, valuePtr, &objc, &objv) == TCL_OK) + && ( + !TclHasInternalRep(value2Ptr, &tclListType.objType) + || + ((Tcl_ListObjLength(interp,value2Ptr,&value2Length), + value2Length == 1 + ? (value2Ptr = TclListObjGetElement(value2Ptr, 0), 1) + : 0 + )) + ) + ) { + int code; + + /* increment the refCount of value2Ptr because TclListObjGetElemen may + * have just extracted it from a list in the condition for this block. + */ + Tcl_IncrRefCount(value2Ptr); - DECACHE_STACK_INFO(); - code = TclGetIntForIndexM(interp, value2Ptr, objc-1, &index); - CACHE_STACK_INFO(); - if (code == TCL_OK) { + DECACHE_STACK_INFO(); + code = TclGetIntForIndexM(interp, value2Ptr, objc-1, &index); TclDecrRefCount(value2Ptr); - tosPtr--; - pcAdjustment = 1; - goto lindexFastPath; + CACHE_STACK_INFO(); + if (code == TCL_OK) { + tosPtr--; + pcAdjustment = 1; + goto lindexFastPath; + } + Tcl_ResetResult(interp); } - Tcl_ResetResult(interp); } + DECACHE_STACK_INFO(); objResultPtr = TclLindexList(interp, valuePtr, value2Ptr); CACHE_STACK_INFO(); diff --git a/generic/tclInt.h b/generic/tclInt.h index 8f87523..aa97b30 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2584,6 +2584,7 @@ typedef struct ListRep { (((objv_) = &ListObjStorePtr(listObj_)->slots[ListObjStart(listObj_)]), \ (ListObjLength(listObj_, (objc_)))) + /* * Returns 1/0 whether the internal representation (not the Tcl_Obj itself) * is shared. Note by intent this only checks for sharing of ListStore, @@ -3115,6 +3116,7 @@ MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp, Tcl_Namespace *ensembleNamespacePtr, int flags); MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); MODULE_SCOPE void TclDeleteNamespaceChildren(Namespace *nsPtr); +MODULE_SCOPE Tcl_Size TclDictGetSize(Tcl_Obj *dictPtr); MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp, const char *dict, Tcl_Size dictLength, const char **elementPtr, const char **nextPtr, @@ -3241,6 +3243,9 @@ MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *argPtr); MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size indexCount, Tcl_Obj *const indexArray[]); + + +MODULE_SCOPE Tcl_Obj * TclListObjGetElement(Tcl_Obj *listObj, Tcl_Size index); /* TIP #280 */ MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, Tcl_Size line, int n, int *lines, Tcl_Obj *const *elems); @@ -3287,6 +3292,7 @@ MODULE_SCOPE void TclParseInit(Tcl_Interp *interp, const char *string, MODULE_SCOPE Tcl_Size TclParseAllWhiteSpace(const char *src, Tcl_Size numBytes); MODULE_SCOPE int TclProcessReturn(Tcl_Interp *interp, int code, int level, Tcl_Obj *returnOpts); +MODULE_SCOPE void TclRelaxRefCount(Tcl_Obj *objPtr); MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); MODULE_SCOPE Tcl_Obj * TclpTempFileName(void); MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 170dd69..9ffc03c 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1642,6 +1642,29 @@ TclListObjRange( /* *---------------------------------------------------------------------- * + * TclListObjGetElement -- + * + * Returns a single element from the array of the elements in a list + * object, without doing doing any bounds checking. Caller must ensure + * that ObjPtr of of type 'tclListType' and that index is valid for the + * list. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TclListObjGetElement( + Tcl_Obj *objPtr, /* List object for which an element array is + * to be returned. */ + Tcl_Size index +) +{ + return ListObjStorePtr(objPtr)->slots[ListObjStart(objPtr) + index]; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_ListObjGetElements -- * * This function returns an (objc,objv) array of the elements in a list diff --git a/generic/tclObj.c b/generic/tclObj.c index 0c9c405..97e262b 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -3707,7 +3707,7 @@ Tcl_IncrRefCount( * Decrements the reference count of the object. * * Results: - * None. + * The storage for objPtr may be freed. * *---------------------------------------------------------------------- */ @@ -3725,6 +3725,28 @@ Tcl_DecrRefCount( /* *---------------------------------------------------------------------- * + * TclRelaxRefCount -- + * + * Decrement the refCount of objPtr without causing it to be freed if it + * drops from 1 to 0. This allows a function increment a refCount but + * then decrement it and still be able to pass return it to a caller, + * possibly with a refCount of 0. The caller must have previously + * incremented the refCount. + * + *---------------------------------------------------------------------- + */ +void +TclRelaxRefCount( + Tcl_Obj *objPtr) /* The object we are releasing a reference to. */ +{ + if (objPtr->refCount > 0) { + --objPtr->refCount; + } +} + +/* + *---------------------------------------------------------------------- + * * Tcl_IsShared -- * * Tests if the object has a ref count greater than one. -- cgit v0.12