Add TclRelaxRefCount, and also try to take the fast path more often in byte-compiled [lindex].

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.