Attachment "nsChildTable.patch" to
ticket [2694630fff]
added by
dkf
2009-03-19 22:05:20.
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.418
diff -u -r1.418 tclInt.h
--- generic/tclInt.h 9 Mar 2009 09:12:39 -0000 1.418
+++ generic/tclInt.h 19 Mar 2009 14:56:40 -0000
@@ -236,8 +236,10 @@
struct Namespace *parentPtr;/* Points to the namespace that contains this
* one. NULL if this is the global
* namespace. */
- Tcl_HashTable childTable; /* Contains any child namespaces. Indexed by
- * strings; values have type (Namespace *). */
+ Tcl_HashTable *childTablePtr;
+ /* Contains any child namespaces. Indexed by
+ * strings; values have type (Namespace *). If
+ * NULL, there are no children. */
long nsId; /* Unique id for the namespace. */
Tcl_Interp *interp; /* The interpreter containing this
* namespace. */
Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.189
diff -u -r1.189 tclNamesp.c
--- generic/tclNamesp.c 10 Feb 2009 22:50:07 -0000 1.189
+++ generic/tclNamesp.c 19 Mar 2009 14:56:41 -0000
@@ -795,7 +795,8 @@
* already exist in the parent namespace.
*/
- if (Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL) {
+ if (parentPtr->childTablePtr != NULL &&
+ Tcl_FindHashEntry(parentPtr->childTablePtr,simpleName)!=NULL){
Tcl_AppendResult(interp, "can't create namespace \"", name,
"\": already exists", NULL);
return NULL;
@@ -814,7 +815,7 @@
nsPtr->clientData = clientData;
nsPtr->deleteProc = deleteProc;
nsPtr->parentPtr = parentPtr;
- Tcl_InitHashTable(&nsPtr->childTable, TCL_STRING_KEYS);
+ nsPtr->childTablePtr = NULL;
nsPtr->nsId = ++(tsdPtr->numNsCreated);
nsPtr->interp = interp;
nsPtr->flags = 0;
@@ -838,7 +839,12 @@
nsPtr->commandPathSourceList = NULL;
if (parentPtr != NULL) {
- entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName,
+ if (parentPtr->childTablePtr == NULL) {
+ parentPtr->childTablePtr = (Tcl_HashTable *)
+ ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(parentPtr->childTablePtr, TCL_STRING_KEYS);
+ }
+ entryPtr = Tcl_CreateHashEntry(parentPtr->childTablePtr, simpleName,
&newEntry);
Tcl_SetHashValue(entryPtr, nsPtr);
} else {
@@ -992,7 +998,7 @@
if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) {
nsPtr->flags |= NS_DYING;
if (nsPtr->parentPtr != NULL) {
- entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
+ entryPtr = Tcl_FindHashEntry(nsPtr->parentPtr->childTablePtr,
nsPtr->name);
if (entryPtr != NULL) {
Tcl_DeleteHashEntry(entryPtr);
@@ -1022,7 +1028,10 @@
TclDeleteNamespaceVars(nsPtr);
- Tcl_DeleteHashTable(&nsPtr->childTable);
+ if (nsPtr->childTablePtr != NULL) {
+ Tcl_DeleteHashTable(nsPtr->childTablePtr);
+ ckfree((char *) nsPtr->childTablePtr);
+ }
Tcl_DeleteHashTable(&nsPtr->cmdTable);
/*
@@ -1118,7 +1127,7 @@
*/
if (nsPtr->parentPtr != NULL) {
- entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
+ entryPtr = Tcl_FindHashEntry(nsPtr->parentPtr->childTablePtr,
nsPtr->name);
if (entryPtr != NULL) {
Tcl_DeleteHashEntry(entryPtr);
@@ -1156,11 +1165,13 @@
* Don't optimize to Tcl_NextHashEntry() because of traces.
*/
- for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
- entryPtr != NULL;
- entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
- childNsPtr = Tcl_GetHashValue(entryPtr);
- Tcl_DeleteNamespace(childNsPtr);
+ if (nsPtr->childTablePtr != NULL) {
+ for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
+ entryPtr != NULL;
+ entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr,&search)) {
+ childNsPtr = Tcl_GetHashValue(entryPtr);
+ Tcl_DeleteNamespace(childNsPtr);
+ }
}
/*
@@ -2218,7 +2229,11 @@
*/
if (nsPtr != NULL) {
- entryPtr = Tcl_FindHashEntry(&nsPtr->childTable, nsName);
+ if (nsPtr->childTablePtr == NULL) {
+ entryPtr = NULL;
+ } else {
+ entryPtr = Tcl_FindHashEntry(nsPtr->childTablePtr, nsName);
+ }
if (entryPtr != NULL) {
nsPtr = Tcl_GetHashValue(entryPtr);
} else if (flags & TCL_CREATE_NS_IF_UNKNOWN) {
@@ -2227,8 +2242,8 @@
(void) TclPushStackFrame(interp, &framePtr,
(Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0);
- nsPtr = (Namespace *) Tcl_CreateNamespace(interp, nsName,
- NULL, NULL);
+ nsPtr = (Namespace *)
+ Tcl_CreateNamespace(interp, nsName, NULL, NULL);
TclPopStackFrame(interp);
if (nsPtr == NULL) {
@@ -2245,7 +2260,11 @@
*/
if (altNsPtr != NULL) {
- entryPtr = Tcl_FindHashEntry(&altNsPtr->childTable, nsName);
+ if (altNsPtr->childTablePtr != NULL) {
+ entryPtr = Tcl_FindHashEntry(altNsPtr->childTablePtr, nsName);
+ } else {
+ entryPtr = NULL;
+ }
if (entryPtr != NULL) {
altNsPtr = Tcl_GetHashValue(entryPtr);
} else {
@@ -2625,8 +2644,12 @@
for (i = trailFront; i >= 0; i--) {
trailNsPtr = trailPtr[i];
- hPtr = Tcl_FindHashEntry(&shadowNsPtr->childTable,
- trailNsPtr->name);
+ if (shadowNsPtr->childTablePtr != NULL) {
+ hPtr = Tcl_FindHashEntry(shadowNsPtr->childTablePtr,
+ trailNsPtr->name);
+ } else {
+ hPtr = NULL;
+ }
if (hPtr != NULL) {
shadowNsPtr = Tcl_GetHashValue(hPtr);
} else {
@@ -2996,13 +3019,17 @@
if (strncmp(pattern, nsPtr->fullName, length) != 0) {
goto searchDone;
}
- if (Tcl_FindHashEntry(&nsPtr->childTable, pattern+length) != NULL) {
+ if (nsPtr->childTablePtr != NULL &&
+ Tcl_FindHashEntry(nsPtr->childTablePtr,pattern+length)!=NULL){
Tcl_ListObjAppendElement(interp, listPtr,
Tcl_NewStringObj(pattern, -1));
}
goto searchDone;
}
- entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
+ if (nsPtr->childTablePtr == NULL) {
+ goto searchDone;
+ }
+ entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
while (entryPtr != NULL) {
childNsPtr = Tcl_GetHashValue(entryPtr);
if ((pattern == NULL)
Index: generic/tclResolve.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclResolve.c,v
retrieving revision 1.10
diff -u -r1.10 tclResolve.c
--- generic/tclResolve.c 27 Apr 2008 22:21:32 -0000 1.10
+++ generic/tclResolve.c 19 Mar 2009 14:56:41 -0000
@@ -262,11 +262,13 @@
nsPtr->cmdRefEpoch++;
- for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
- entry != NULL; entry = Tcl_NextHashEntry(&search)) {
- Namespace *childNsPtr = Tcl_GetHashValue(entry);
+ if (nsPtr->childTablePtr != NULL) {
+ for (entry = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
+ entry != NULL; entry = Tcl_NextHashEntry(&search)) {
+ Namespace *childNsPtr = Tcl_GetHashValue(entry);
- BumpCmdRefEpochs(childNsPtr);
+ BumpCmdRefEpochs(childNsPtr);
+ }
}
TclInvalidateNsPath(nsPtr);
}
Index: pkgs/itcl/generic/itclMigrate2TclCore.c
===================================================================
RCS file: /cvsroot/tcl/itcl/generic/itclMigrate2TclCore.c,v
retrieving revision 1.1.1.4
diff -u -r1.1.1.4 itclMigrate2TclCore.c
--- pkgs/itcl/generic/itclMigrate2TclCore.c 3 Feb 2009 20:35:00 -0000 1.1.1.4
+++ pkgs/itcl/generic/itclMigrate2TclCore.c 19 Mar 2009 14:56:41 -0000
@@ -47,7 +47,12 @@
_Tcl_GetNamespaceChildTable(
Tcl_Namespace *nsPtr)
{
- return &((Namespace *)nsPtr)->childTable;
+ Namespace *nPtr = (Namespace *) nsPtr;
+ if (nPtr->childTablePtr == NULL) {
+ nPtr->childTablePtr = (Tcl_HashTable*) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(nPtr->childTablePtr, TCL_STRING_KEYS);
+ }
+ return nPtr->childTablePtr;
}
int
