Tcl Source Code

Artifact [e52679bf7c]
Login

Artifact e52679bf7c257fe3fac6eacde255dade6b2cf2df:

Attachment "ekeko.patch" to ticket [1829248fff] added by msofer 2007-11-10 04:34:18.
? cmdSource.diff
? ekeko.patch
? jeff.chat
? tclExecute.c.patch
? tclVar.c.diff
? tclVar.c.diff2
? generic/tclEncoding.c.BAD
? generic/tclEncoding.c.CVS
? generic/tclExecute.c.diff
? generic/tclExecute.c.myTime
? generic/tclInt.h.OK
? generic/tclVar.c.CVS
? generic/tclVar.c.cvs
? unix/0valgrind
? unix/CACHE.res
? unix/CACHE2.res
? unix/CACHE3.res
? unix/CACHE4.res
? unix/ERR
? unix/GPS
? unix/autom4te.cache
? unix/cachegrind.out.19902
? unix/cachegrind.out.22468
? unix/cachegrind.out.23361
? unix/cachegrind.out.23983
? unix/cachegrind.out.25392
? unix/cachegrind.out.26820
? unix/cachegrind.out.27583
? unix/config.status.lineno
? unix/dltest.marker
? unix/httpd_19974
? unix/rc
? unix/time.log
? win/autom4te.cache
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.3750
diff -u -r1.3750 ChangeLog
--- ChangeLog	9 Nov 2007 18:55:13 -0000	1.3750
+++ ChangeLog	9 Nov 2007 21:28:09 -0000
@@ -1,3 +1,5 @@
+2007-11-09  Miguel Sofer  <[email protected]>
+
 2007-11-09  Jeff Hobbs  <[email protected]>
 
 	* generic/tclInt.decls, generic/tclIntDecls.h: Use unsigned char for
Index: generic/tclAsync.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclAsync.c,v
retrieving revision 1.10
diff -u -r1.10 tclAsync.c
--- generic/tclAsync.c	11 Jul 2006 14:29:14 -0000	1.10
+++ generic/tclAsync.c	9 Nov 2007 21:28:10 -0000
@@ -324,6 +324,12 @@
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     return tsdPtr->asyncReady;
 }
+
+int *
+TclGetAsyncReadyPtr(void) {
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    return &(tsdPtr->asyncReady);
+}
 
 /*
  * Local Variables:
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.270
diff -u -r1.270 tclBasic.c
--- generic/tclBasic.c	25 Sep 2007 20:27:17 -0000	1.270
+++ generic/tclBasic.c	9 Nov 2007 21:28:10 -0000
@@ -333,6 +333,35 @@
     { NULL,	NULL,			NULL,
 		{0},			NULL }
 };
+
+
+#ifdef TCL_NO_STACK_CHECK
+#define CheckStackSpace(interp, localIntPtr) 1
+#else /* stack checlk enabled */
+#ifdef _TCLUNIXPORT
+/*
+ * A unix system: cache the stack check parameters.
+ */
+
+static int stackGrowsDown = 1;
+
+#define CheckStackSpace(iPtr, localIntPtr) \
+    (stackGrowsDown \
+        ? ((localIntPtr) > (iPtr)->stackBound)	\
+	: ((localIntPtr) < (iPtr)->stackBound)	\
+    )
+#else /* not unix */
+/*
+ * FIXME: can we do something similar for other platforms, especially windows? 
+ */
+
+#define TclpGetCStackParams(foo) 1;
+#define CheckStackSpace(interp, localIntPtr) \
+    TclpCheckStackSpace()
+#endif
+#endif
+
+
 
 /*
  *----------------------------------------------------------------------
@@ -572,6 +601,20 @@
     TclInitLimitSupport(interp);
 
     /*
+     * Initialise the thread-specific data ekeko.
+     */
+
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+    iPtr->allocCache = TclpGetAllocCache();
+#else
+    iPtr->allocCache = NULL;
+#endif
+    iPtr->pendingObjDataPtr = NULL;
+    iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
+
+    stackGrowsDown = TclpGetCStackParams(&iPtr->stackBound);
+
+    /*
      * Create the core commands. Do it here, rather than calling
      * Tcl_CreateCommand, because it's faster (there's no need to check for a
      * pre-existing command by the same name). If a command has a Tcl_CmdProc
@@ -3376,6 +3419,7 @@
 TclInterpReady(
     Tcl_Interp *interp)
 {
+    int localInt; /* used for checking the stack */
     register Interp *iPtr = (Interp *) interp;
 
     /*
@@ -3404,7 +3448,7 @@
      */
 
     if (((iPtr->numLevels) > iPtr->maxNestingDepth)
-	    || (TclpCheckStackSpace() == 0)) {
+	    || (CheckStackSpace(iPtr, &localInt) == 0)) {
 	Tcl_AppendResult(interp,
 		"too many nested evaluations (infinite loop?)", NULL);
 	return TCL_ERROR;
@@ -3471,7 +3515,7 @@
     Namespace *savedNsPtr = NULL;
     Namespace *lookupNsPtr = iPtr->lookupNsPtr;
     Tcl_Obj *commandPtr = NULL;
-    
+
     if (TclInterpReady(interp) == TCL_ERROR) {
 	return TCL_ERROR;
     }
@@ -3615,7 +3659,8 @@
 	    TCL_DTRACE_CMD_RETURN(TclGetString(objv[0]), code);
 	}
     }
-    if (Tcl_AsyncReady()) {
+
+    if (TclAsyncReady(iPtr)) {
 	code = Tcl_AsyncInvoke(interp, code);
     }
     if (code == TCL_OK && TclLimitReady(iPtr->limit)) {
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.342
diff -u -r1.342 tclExecute.c
--- generic/tclExecute.c	9 Nov 2007 18:55:14 -0000	1.342
+++ generic/tclExecute.c	9 Nov 2007 21:28:10 -0000
@@ -1734,7 +1734,7 @@
 	 * ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-<1).
 	 */
 
-	if (Tcl_AsyncReady()) {
+	if (TclAsyncReady(iPtr)) {
 	    int localResult;
 
 	    DECACHE_STACK_INFO();
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.337
diff -u -r1.337 tclInt.h
--- generic/tclInt.h	27 Oct 2007 13:15:58 -0000	1.337
+++ generic/tclInt.h	9 Nov 2007 21:28:10 -0000
@@ -1837,17 +1837,51 @@
     Tcl_HashTable varSearches; /* Hashtable holding the start of a variable's
 				 * active searches list; varPtr is the key */
     /*
+     * The thread-specific data ekeko: cache pointers or values that
+     *  (a) do not change during the thread's lifetime
+     *  (b) require access to TSD to determine at runtime
+     *  (c) are accessed very often (eg, at each command call)
+     *
+     * Note that these are the same for all interps in the same thread. They
+     * just have to be initialised for the thread's master interp, slaves
+     * inherit the value.
+     *
+     * They are used by the macros defined below.
+     */
+
+    void       *allocCache;
+    void       *pendingObjDataPtr; /* Pointer to the Cache and PendingObjData
+				    * structs for this interp's thread; see
+				    * tclObj.c and tclThreadAlloc.c */ 
+    int        *asyncReadyPtr;     /* Pointer to the asyncReady indicator for
+				    * this interp's thread; see tclAsync.c */
+    int        *stackBound;        /* Pointer to the limit stack address
+				    * allowable for invoking a new command
+				    * without "risking" a C-stack overflow;
+				    * see TclpCheckStackSpace in the
+				    * platform's directory. */
+
+
+#ifdef TCL_COMPILE_STATS
+    /*
      * Statistical information about the bytecode compiler and interpreter's
      * operation.
      */
 
-#ifdef TCL_COMPILE_STATS
     ByteCodeStats stats;	/* Holds compilation and execution statistics
 				 * for this interpreter. */
 #endif /* TCL_COMPILE_STATS */
 } Interp;
 
 /*
+ * Macros that use the TSD-ekeko 
+ */
+
+#define TclAsyncReady(iPtr) \
+    *((iPtr)->asyncReadyPtr)
+
+
+/*
  * General list of interpreters. Doubly linked for easier removal of items
  * deep in the list.
  */
@@ -2381,6 +2415,7 @@
 MODULE_SCOPE void	TclFormatNaN(double value, char *buffer);
 MODULE_SCOPE int	TclFSFileAttrIndex(Tcl_Obj *pathPtr,
 			    CONST char *attributeName, int *indexPtr);
+MODULE_SCOPE int *      TclGetAsyncReadyPtr(void);
 MODULE_SCOPE Tcl_Obj *	TclGetBgErrorHandler(Tcl_Interp *interp);
 MODULE_SCOPE int	TclGetNumberFromObj(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr, ClientData *clientDataPtr,
Index: unix/tclUnixInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixInit.c,v
retrieving revision 1.71
diff -u -r1.71 tclUnixInit.c
--- unix/tclUnixInit.c	31 Jul 2007 10:04:28 -0000	1.71
+++ unix/tclUnixInit.c	9 Nov 2007 21:28:10 -0000
@@ -343,6 +343,15 @@
 MODULE_SCOPE long tclMacOSXDarwinRelease;
 long tclMacOSXDarwinRelease = 0;
 #endif
+
+/*
+ * Auxiliary function to compute the direction of stack growth, and a static
+ * variable to cache the result.
+ */
+
+static stackGrowsDown = -1;
+static int StackGrowsDown(int *parent);
+
 
 /*
  *---------------------------------------------------------------------------
@@ -1017,6 +1026,7 @@
  * Side effects:
  *	None.
  *
+ * Remark: Unused in the core, to be removed.
  *----------------------------------------------------------------------
  */
 
@@ -1034,25 +1044,59 @@
 
 #else
 
+    int localInt, *stackBound;
+
+    TclpGetCStackParams(&stackBound);
+
+    if (stackGrowsDown) {
+	return (&localInt > stackBound) ;
+    } else {
+	return (&localInt > stackBound) ;
+    }
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetStackParams --
+ *
+ *        Determine tha stack params for the current thread: in which
+ *        direction does the stack grow, and what is the stack lower (resp
+ *        upper) bound for safe invocation of a new command. This is used to
+ *        cache the values needed for an efficient computation of
+ *        TclpCheckStackSpace() when the interp is known.
+ *
+ *    Results:
+ *        Returns 1 if the stack grows down, in which case a stack lower bound
+ *        is stored at stackBoundPtr. If the stack grows up, 0 is returned and
+ *        an upper bound is stored at stackBoundPtr. If a bound cannot be
+ *        determined NULL is stored at stackBoundPtr.
+ */
+
+int
+TclpGetCStackParams(
+    int **stackBoundPtr)
+{
+#ifdef TCL_NO_STACK_CHECK
+    *stackBoundPtr = NULL;
+    return 0;
+#else
+    int localVar;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 				/* Most variables are actually in a
 				 * thread-specific data block to minimise the
 				 * impact on the stack. */
-    register size_t stackUsed;
-    int localVar;		/* Reference to somewhere on the local stack.
-				 * This is declared last so it's as "deep" as
-				 * possible. */
-
-    if (tsdPtr == NULL) {
+	
+    if (stackGrowsDown == -1) {
 	/*
-	 * This should probably be a panic(); if we're out of stack, we might
-	 * have virtually no room to manoeuver at all.
+	 * Not initialised!
 	 */
 
-	Tcl_Panic("failed to get thread specific stack check data");
+	stackGrowsDown = StackGrowsDown(&localVar);
     }
 
-    /*
+        /*
      * The first time through, we record the "outermost" stack frame.
      */
 
@@ -1073,41 +1117,34 @@
 	tsdPtr->initialised = 1;
     }
 
-    switch (tsdPtr->stackDetermineResult) {
-    case TCL_BREAK:
-	STACK_DEBUG(("skipping stack check with failure\n"));
-	return 0;
-    case TCL_CONTINUE:
-	STACK_DEBUG(("skipping stack check with success\n"));
-	return 1;
+    if (tsdPtr->stackDetermineResult != TCL_OK) {
+	switch (tsdPtr->stackDetermineResult) {
+	    case TCL_BREAK:
+		STACK_DEBUG(("skipping stack checks with failure\n"));
+	    case TCL_CONTINUE:
+		STACK_DEBUG(("skipping stack checks with success\n"));
+	}
+	*stackBoundPtr = NULL;
+	return 1; /* so that check always succeeds */
     }
 
-    /*
-     * Sanity check to see if somehow the stack started going the
-     * other way.
-     */
-
-    if (&localVar > tsdPtr->outerVarPtr) {
-	stackUsed = (char *)&localVar - (char *)tsdPtr->outerVarPtr;
+    if (stackGrowsDown) {
+	*stackBoundPtr = tsdPtr->outerVarPtr - tsdPtr->stackSize;
     } else {
-	stackUsed = (char *)tsdPtr->outerVarPtr - (char *)&localVar;
+	*stackBoundPtr = tsdPtr->outerVarPtr + tsdPtr->stackSize;
     }
+    return stackGrowsDown;
+#endif
+}
 
-    /*
-     * Now we perform the actual check. Are we about to blow our stack frame?
-     */
-
-    if (stackUsed < tsdPtr->stackSize) {
-	STACK_DEBUG(("stack OK\tin:%p\tout:%p\tuse:%04X\tmax:%04X\n",
-		&localVar, tsdPtr->outerVarPtr, stackUsed, tsdPtr->stackSize));
-	return 1;
-    } else {
-	STACK_DEBUG(("stack OVERFLOW\tin:%p\tout:%p\tuse:%04X\tmax:%04X\n",
-		&localVar, tsdPtr->outerVarPtr, stackUsed, tsdPtr->stackSize));
-	return 0;
-    }
-#endif /* TCL_NO_STACK_CHECK */
+int
+StackGrowsDown(
+    int *parent)
+{
+    int here;
+    return (&here < parent);
 }
+
 
 /*
  *----------------------------------------------------------------------
Index: unix/tclUnixPort.h
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixPort.h,v
retrieving revision 1.58
diff -u -r1.58 tclUnixPort.h
--- unix/tclUnixPort.h	11 Oct 2007 21:35:03 -0000	1.58
+++ unix/tclUnixPort.h	9 Nov 2007 21:28:10 -0000
@@ -679,4 +679,7 @@
 MODULE_SCOPE struct hostent* TclpGetHostByName(const char *name);
 MODULE_SCOPE struct hostent* TclpGetHostByAddr(const char *addr, int length, int type);
 
+
+MODULE_SCOPE int TclpGetCStackParams(int **stackBound);
+
 #endif /* _TCLUNIXPORT */