TkGetWindowFromObj was useless CPU waster; now caches window names *safely*

4 files changed, 131 insertions, 17 deletions

diff --git a/ChangeLog b/ChangeLog
index 2c08b97..084442d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,19 @@
+2001-08-20  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
+
+	* generic/tkObj.c (TkGetWindowFromObj): Rewrote window code to
+	reuse a previously worked-out set of window information exactly
+	when the reference window is the same and no window deletions have
+	occurred since the object was allocated (display has same epoch
+	counter.)  Required changing the internal rep of the window quite
+	a bit as now need to save three words-worth of information in the
+	internal rep (this window, reference window, display epoch.)
+	* generic/tkObj.c (SetWindowFromAny, DupWindowInternalRep,
+	FreeWindowInternalRep): Code to support new internal rep for
+	window objects.
+	* generic/tkInt.h: Added epoch counter to TkDisplay structure
+	* generic/tkWindow.c (GetScreen, Tk_DestroyWindow): Epoch counter
+	is incremented every time a window is deleted.
+
 2001-08-18  Peter Spjuth <peter.spjuth@space.se>
 	* doc/grid.n:
 	* tests/grid.test:
diff --git a/generic/tkInt.h b/generic/tkInt.h
index a39fa91..e94f0c6 100644
--- a/generic/tkInt.h
+++ b/generic/tkInt.h
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: $Id: tkInt.h,v 1.36 2001/08/15 15:44:36 dkf Exp $ 
+ * RCS: $Id: tkInt.h,v 1.37 2001/08/21 14:43:08 dkf Exp $ 
  */
 
 #ifndef _TKINT
@@ -474,6 +474,11 @@ typedef struct TkDisplay {
     int warpX;
     int warpY;
     int useInputMethods;	/* Whether to use input methods */
+
+    /*
+     * The following field(s) were all added for Tk8.4
+     */
+    long deletionEpoch;		/* Incremented by window deletions */
 } TkDisplay;
 
 /*
diff --git a/generic/tkObj.c b/generic/tkObj.c
index 2fdc710..26d5f79 100644
--- a/generic/tkObj.c
+++ b/generic/tkObj.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkObj.c,v 1.6 2001/08/17 09:38:30 dkf Exp $
+ * RCS: @(#) $Id: tkObj.c,v 1.7 2001/08/21 14:43:08 dkf Exp $
  */
 
 #include "tkInt.h"
@@ -55,6 +55,16 @@ typedef struct MMRep {
 } MMRep;
 
 /*
+ * The following structure is the internal representation for window objects.
+ */
+ 
+typedef struct WindowRep {
+    Tk_Window tkwin;
+    Tk_Window mainwin;
+    long epoch;
+} WindowRep;
+
+/*
  * Prototypes for procedures defined later in this file:
  */
 
@@ -62,8 +72,11 @@ static void		DupMMInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
 			    Tcl_Obj *copyPtr));
 static void		DupPixelInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
 			    Tcl_Obj *copyPtr));
+static void		DupWindowInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr));
 static void		FreeMMInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
 static void		FreePixelInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void		FreeWindowInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
 static void		UpdateStringOfMM _ANSI_ARGS_((Tcl_Obj *objPtr));
 static int		SetMMFromAny _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Obj *objPtr));
@@ -71,7 +84,7 @@ static int		SetPixelFromAny _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Obj *objPtr));
 static int		SetWindowFromAny _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Obj *objPtr));
-			
+
 /*
  * The following structure defines the implementation of the "pixel"
  * Tcl object, used for measuring distances.  The pixel object remembers
@@ -107,8 +120,8 @@ static Tcl_ObjType mmObjType = {
 
 static Tcl_ObjType windowObjType = {
     "window",				/* name */
-    (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
-    (Tcl_DupInternalRepProc *) NULL,	/* dupIntRepProc */
+    FreeWindowInternalRep,		/* freeIntRepProc */
+    DupWindowInternalRep,		/* dupIntRepProc */
     NULL,				/* updateStringProc */
     SetWindowFromAny			/* setFromAnyProc */
 };
@@ -666,10 +679,12 @@ int
 TkGetWindowFromObj(interp, tkwin, objPtr, windowPtr)
     Tcl_Interp *interp; 	/* Used for error reporting if not NULL. */
     Tk_Window tkwin;		/* A token to get the main window from. */
-    register Tcl_Obj *objPtr;	/* The object from which to get boolean. */
+    Tcl_Obj *objPtr;		/* The object from which to get boolean. */
     Tk_Window *windowPtr;	/* Place to store resulting window. */
 {
-    Tk_Window lastWindow;
+    register WindowRep *winPtr;
+    TkDisplay *dispPtr = ((TkWindow *)tkwin)->dispPtr;
+    Tk_Window foundWindow;
 
     if (objPtr->typePtr != &windowObjType) {
 	register int result = SetWindowFromAny(interp, objPtr);
@@ -678,19 +693,27 @@ TkGetWindowFromObj(interp, tkwin, objPtr, windowPtr)
 	}
     }
 
-    lastWindow = (Tk_Window) objPtr->internalRep.twoPtrValue.ptr1;
-    if (tkwin != lastWindow) {
-	Tk_Window foundWindow = Tk_NameToWindow(interp,
-		Tcl_GetStringFromObj(objPtr, NULL), tkwin);
+    winPtr = (WindowRep *) objPtr->internalRep.otherValuePtr;
+    if (winPtr == NULL) {
+	winPtr = (WindowRep *) ckalloc(sizeof(WindowRep));
+	objPtr->internalRep.otherValuePtr = (VOID *) winPtr;
+	goto parseWindowString;
 
+    } else if (tkwin != winPtr->mainwin ||
+	       dispPtr->deletionEpoch != winPtr->epoch) {
+    parseWindowString:
+	foundWindow = Tk_NameToWindow(interp,
+		Tcl_GetStringFromObj(objPtr, NULL), tkwin);
 	if (foundWindow == NULL) {
 	    return TCL_ERROR;
 	}
-	objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkwin;
-	objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) foundWindow;
+
+	winPtr->tkwin = foundWindow;
+	winPtr->mainwin = tkwin;
+	winPtr->epoch = dispPtr->deletionEpoch;
     }
-    *windowPtr = (Tk_Window) objPtr->internalRep.twoPtrValue.ptr2;
 
+    *windowPtr = winPtr->tkwin;
     return TCL_OK;
 }
 
@@ -731,8 +754,7 @@ SetWindowFromAny(interp, objPtr)
 	(*typePtr->freeIntRepProc)(objPtr);
     }
     objPtr->typePtr = &windowObjType;
-    objPtr->internalRep.twoPtrValue.ptr1 = NULL;
-    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    objPtr->internalRep.otherValuePtr = NULL;
 
     return TCL_OK;
 }
@@ -740,6 +762,72 @@ SetWindowFromAny(interp, objPtr)
 /*
  *----------------------------------------------------------------------
  *
+ * DupWindowInternalRep --
+ *
+ *	Initialize the internal representation of a window Tcl_Obj to a
+ *	copy of the internal representation of an existing window object. 
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	copyPtr's internal rep is set to refer to the same window as
+ *	srcPtr's internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupWindowInternalRep(srcPtr, copyPtr)
+    register Tcl_Obj *srcPtr;
+    register Tcl_Obj *copyPtr;
+{
+    register WindowRep *oldPtr, *newPtr;
+
+    copyPtr->typePtr = srcPtr->typePtr;
+    oldPtr = srcPtr->internalRep.otherValuePtr;
+    if (oldPtr == NULL) {
+	copyPtr->internalRep.otherValuePtr = NULL;
+    } else {
+	newPtr = (WindowRep *) ckalloc(sizeof(WindowRep));
+	newPtr->tkwin = oldPtr->tkwin;
+	newPtr->mainwin = oldPtr->mainwin;
+	newPtr->epoch = oldPtr->epoch;
+	copyPtr->internalRep.otherValuePtr = (VOID *)newPtr;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeWindowInternalRep --
+ *
+ *	Deallocate the storage associated with a window object's internal
+ *	representation.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Frees objPtr's internal representation and sets objPtr's
+ *	internalRep to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeWindowInternalRep(objPtr)
+    Tcl_Obj *objPtr;		/* Window object with internal rep to free. */
+{
+    if (objPtr->internalRep.otherValuePtr != NULL) {
+	ckfree((char *) objPtr->internalRep.otherValuePtr);
+	objPtr->internalRep.otherValuePtr = NULL;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TkRegisterObjTypes --
  *
  *	Registers Tk's Tcl_ObjType structures with the Tcl run-time.
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index ca1c9f7..1102fab 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkWindow.c,v 1.33 2001/08/15 15:44:36 dkf Exp $
+ * RCS: @(#) $Id: tkWindow.c,v 1.34 2001/08/21 14:43:08 dkf Exp $
  */
 
 #include "tkPort.h"
@@ -470,6 +470,7 @@ GetScreen(interp, screenName, screenPtr)
 	    dispPtr->useInputMethods = 0;
 	    OpenIM(dispPtr);
 	    TkInitXId(dispPtr);
+	    dispPtr->deletionEpoch = 0L;
 
 	    tsdPtr->displayList = dispPtr;
 	    break;
@@ -1387,6 +1388,10 @@ Tk_DestroyWindow(tkwin)
 		    (ClientData) winPtr->pathName);
 	    Tcl_DeleteHashEntry(Tcl_FindHashEntry(&winPtr->mainPtr->nameTable,
 		    winPtr->pathName));
+	    /*
+	     * Invalidate all objects referring to windows on this display.
+	     */
+	    dispPtr->deletionEpoch++;
 	}
 	winPtr->mainPtr->refCount--;
 	if (winPtr->mainPtr->refCount == 0) {