fixes [4fff3fc277] (Itcl not thread-safe) - use tcl-internal threaded…

…-object cache instead of (unsafe) Itcl-internal list pool.
tcltk · Aug 24, 2024 · ba392e5 · ba392e5
1 parent f34ea69
commit ba392e5
Show file tree

Hide file tree

Showing 3 changed files with 21 additions and 50 deletions.
diff --git a/generic/itclBase.c b/generic/itclBase.c
@@ -652,8 +652,5 @@ FreeItclObjectInfo(
 	infoPtr->class_meta_type = NULL;
     }
 
-    /* clean up list pool */
-    Itcl_FinishList();
-
     Itcl_ReleaseData(infoPtr);
 }
diff --git a/generic/itclInt.h b/generic/itclInt.h
@@ -790,7 +790,6 @@ MODULE_SCOPE int ItclCreateDelegatedFunction(Tcl_Interp *interp,
 	Tcl_Obj *targetPtr, Tcl_Obj *usingPtr, Tcl_Obj *exceptionsPtr,
 	ItclDelegatedFunction **idmPtrPtr);
 MODULE_SCOPE void ItclDeleteDelegatedOption(char *cdata);
-MODULE_SCOPE void Itcl_FinishList();
 MODULE_SCOPE void ItclDeleteDelegatedFunction(ItclDelegatedFunction *idmPtr);
 MODULE_SCOPE void ItclFinishEnsemble(ItclObjectInfo *infoPtr);
 MODULE_SCOPE int Itcl_EnsembleDeleteCmd(void *clientData,

diff --git a/generic/itclUtil.c b/generic/itclUtil.c
@@ -31,14 +31,7 @@
 #include "itclInt.h"
 #include <limits.h>
 
-/*
- *  POOL OF LIST ELEMENTS FOR LINKED LIST
- */
-static Itcl_ListElem *listPool = NULL;
-static int listPoolLen = 0;
-
 #define ITCL_VALID_LIST 0x01face10  /* magic bit pattern for validation */
-#define ITCL_LIST_POOL_SIZE 200     /* max number of elements in listPool */
 
 /*
  *  This structure is used to take a snapshot of the interpreter
@@ -252,9 +245,8 @@ Itcl_DeleteList(
  *  Itcl_CreateListElem()
  *
  *  Low-level routined used by procedures like Itcl_InsertList() and
- *  Itcl_AppendList() to create new list elements.  If elements are
- *  available, one is taken from the list element pool.  Otherwise,
- *  a new one is allocated.
+ *  Itcl_AppendList() to create new list elements.
+ *  This will use threaded-object cache for reuseable list elements.
  * ------------------------------------------------------------------------
  */
 Itcl_ListElem*
@@ -263,11 +255,15 @@ Itcl_CreateListElem(
 {
     Itcl_ListElem *elemPtr;
 
-    if (listPoolLen > 0) {
-	elemPtr = listPool;
-	listPool = elemPtr->next;
-	--listPoolLen;
-    } else {
+    /*
+     * Since size of Itcl_ListElem is always smaller than Tcl_Obj, but very
+     * near on it, we could use threaded-object cache for list elements.
+     */
+    if (sizeof(Itcl_ListElem) <= sizeof(Tcl_Obj)) { /* optimized at compile-time as true */
+	/* TODO: rewrite it once TclThreadAllocObj becomes public */
+	elemPtr = (Itcl_ListElem*)Tcl_NewObj();
+    } else { /* unreachable */
+	assert(0);
 	elemPtr = (Itcl_ListElem*)ckalloc((unsigned)sizeof(Itcl_ListElem));
     }
     elemPtr->owner = listPtr;
@@ -312,12 +308,16 @@ Itcl_DeleteListElem(
     }
     --listPtr->num;
 
-    if (listPoolLen < ITCL_LIST_POOL_SIZE) {
-	elemPtr->next = listPool;
-	listPool = elemPtr;
-	++listPoolLen;
-    } else {
-	ckfree((char*)elemPtr);
+    if (sizeof(Itcl_ListElem) <= sizeof(Tcl_Obj)) { /* optimized at compile-time as true */
+	/* TODO: rewrite it once TclThreadAllocObj/TclThreadFreeObj become public */
+	Tcl_Obj *objPtr = (Tcl_Obj *)elemPtr;
+	objPtr->refCount = 0;
+	objPtr->bytes = NULL;
+	objPtr->typePtr = NULL;
+	Tcl_DecrRefCount(objPtr);
+    } else { /* unreachable */
+	assert(0);
+	ckfree(elemPtr);
     }
     return nextPtr;
 }
@@ -491,31 +491,6 @@ Itcl_SetListValue(
     elemPtr->value = val;
 }
 
-
-/*
- * ------------------------------------------------------------------------
- *  Itcl_FinishList()
- *
- *  free all memory used in the list pool
- * ------------------------------------------------------------------------
- */
-void
-Itcl_FinishList()
-{
-    Itcl_ListElem *listPtr;
-    Itcl_ListElem *elemPtr;
-
-    listPtr = listPool;
-    while (listPtr != NULL) {
-	elemPtr = listPtr;
-	listPtr = elemPtr->next;
-	ckfree((char *)elemPtr);
-	elemPtr = NULL;
-    }
-    listPool = NULL;
-    listPoolLen = 0;
-}
-
 
 /*
  * ========================================================================