* generic/tclBasic.c:

	* generic/tclInt.h:
	* unix/tclUnixInit.c:
	* unix/tclUnixPort.h:
	* win/tclWin32Dll.c: modify the stack checking algorithm to
	recheck in case of failure. The working assumptions are now that
	(a) a thread's stack is never moved, and (b) a thread's stack can
	grow but not shrink. Port to windows - could be more efficient,
	but is already cheaper than it was.

6 files changed, 153 insertions, 114 deletions

diff --git a/ChangeLog b/ChangeLog
index 2aba904..6560a3b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2007-11-10  Miguel Sofer  <msofer@users.sf.net>
+
+	* generic/tclBasic.c:
+	* generic/tclInt.h:
+	* unix/tclUnixInit.c:
+	* unix/tclUnixPort.h:
+	* win/tclWin32Dll.c: modify the stack checking algorithm to
+	recheck in case of failure. The working assumptions are now that
+	(a) a thread's stack is never moved, and (b) a thread's stack can
+	grow but not shrink. Port to windows - could be more efficient,
+	but is already cheaper than it was.
+	
 2007-11-09  Miguel Sofer  <msofer@users.sf.net>
 
 	* generic/tclResult.c (ResetObjResult): new shortcut.
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 09ec05d..2684986 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.272 2007/11/10 03:40:17 das Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.273 2007/11/10 16:08:09 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -334,33 +334,20 @@ static const OpCmdInfo mathOpCmds[] = {
 		{0},			NULL }
 };
 
-#ifdef TCL_NO_STACK_CHECK
-#define CheckStackSpace(interp, localIntPtr) 1
-#else /* stack check enabled */
-#ifdef _TCLUNIXPORT
-/*
- * A unix system: cache the stack check parameters.
- */
-
+#ifndef TCL_NO_STACK_CHECK
 static int stackGrowsDown = 1;
 
 #define GetCStackParams(iPtr) \
-    stackGrowsDown = TclpGetCStackParams(&(iPtr)->stackBound)
+    stackGrowsDown = TclpGetCStackParams(&((iPtr)->stackBoundPtr))
 
 #define CheckStackSpace(iPtr, localIntPtr) \
     (stackGrowsDown \
-        ? ((localIntPtr) > (iPtr)->stackBound)	\
-	: ((localIntPtr) < (iPtr)->stackBound)	\
+	    ? ((localIntPtr) > *((iPtr)->stackBoundPtr))	\
+	    : ((localIntPtr) < *((iPtr)->stackBoundPtr))	\
     )
-#else /* not unix */
-/*
- * FIXME: can we do something similar for other platforms, especially windows? 
- */
-
-#define GetCStackParams(iPtr)
-#define CheckStackSpace(interp, localIntPtr) \
-    TclpCheckStackSpace()
-#endif
+#else /* stack check disabled: make them noops */
+#define CheckStackSpace(interp, localIntPtr) 1
+#define GetCStackParams(iPtr) 
 #endif
 
 
@@ -3420,7 +3407,7 @@ int
 TclInterpReady(
     Tcl_Interp *interp)
 {
-    int localInt; /* used for checking the stack */
+    int localInt, stackOverflow; /* used for checking the stack */
     register Interp *iPtr = (Interp *) interp;
 
     /*
@@ -3448,8 +3435,17 @@ TclInterpReady(
      * probably because of an infinite loop somewhere.
      */
 
-    if (((iPtr->numLevels) > iPtr->maxNestingDepth)
-	    || (CheckStackSpace(iPtr, &localInt) == 0)) {
+    stackOverflow = !CheckStackSpace(iPtr, &localInt); 
+    if (stackOverflow) {
+	/*
+	 * Update the stack params in case the thread's stack was grown.
+	 */
+
+	GetCStackParams(iPtr);
+	stackOverflow = !CheckStackSpace(iPtr, &localInt); 
+    }
+    
+    if (stackOverflow || ((iPtr->numLevels) > iPtr->maxNestingDepth)) {
 	Tcl_AppendResult(interp,
 		"too many nested evaluations (infinite loop?)", NULL);
 	return TCL_ERROR;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index af62562..1dc744c 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.338 2007/11/09 21:35:18 msofer Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.339 2007/11/10 16:08:10 msofer Exp $
  */
 
 #ifndef _TCLINT
@@ -1855,7 +1855,7 @@ typedef struct Interp {
 				    * 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
+    int        **stackBoundPtr;    /* Pointer to the limit stack address
 				    * allowable for invoking a new command
 				    * without "risking" a C-stack overflow;
 				    * see TclpCheckStackSpace in the
@@ -2501,8 +2501,10 @@ MODULE_SCOPE void	TclParseInit(Tcl_Interp *interp, CONST char *string,
 MODULE_SCOPE int	TclParseAllWhiteSpace(CONST char *src, int numBytes);
 MODULE_SCOPE int	TclProcessReturn(Tcl_Interp *interp,
 			    int code, int level, Tcl_Obj *returnOpts);
+#ifndef TCL_NO_STACK_CHECK
+MODULE_SCOPE int        TclpGetCStackParams(int ***stackBound);
+#endif
 MODULE_SCOPE int	TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
-MODULE_SCOPE int	TclpCheckStackSpace(void);
 MODULE_SCOPE Tcl_Obj *	TclpTempFileName(void);
 MODULE_SCOPE Tcl_Obj *	TclNewFSPathObj(Tcl_Obj *dirPtr, CONST char *addStrRep,
 			    int len);
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index 69ae9e4..4ae061c 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -7,7 +7,7 @@
  * Copyright (c) 1999 by Scriptics Corporation.
  * All rights reserved.
  *
- * RCS: @(#) $Id: tclUnixInit.c,v 1.74 2007/11/10 03:41:23 das Exp $
+ * RCS: @(#) $Id: tclUnixInit.c,v 1.75 2007/11/10 16:08:10 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -78,11 +78,12 @@
 typedef struct ThreadSpecificData {
     int *outerVarPtr;		/* The "outermost" stack frame pointer for
 				 * this thread. */
-    int initialised;		/* Have we found what the stack size was? */
     int stackDetermineResult;	/* What happened when we did that? */
-    size_t stackSize;		/* The size of the current stack. */
+    int *stackBound;            /* The current stack boundary */
 } ThreadSpecificData;
 static Tcl_ThreadDataKey dataKey;
+static stackGrowsDown = -1;
+static int StackGrowsDown(int *parent);
 #endif /* TCL_NO_STACK_CHECK */
 
 #ifdef TCL_DEBUG_STACK_CHECK
@@ -344,14 +345,6 @@ 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);
-
 
 /*
  *---------------------------------------------------------------------------
@@ -1015,48 +1008,6 @@ TclpFindVariable(
 /*
  *----------------------------------------------------------------------
  *
- * TclpCheckStackSpace --
- *
- *	Detect if we are about to blow the stack. Called before an evaluation
- *	can happen when nesting depth is checked.
- *
- * Results:
- *	1 if there is enough stack space to continue; 0 if not.
- *
- * Side effects:
- *	None.
- *
- * Remark: Unused in the core, to be removed.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclpCheckStackSpace(void)
-{
-#ifdef TCL_NO_STACK_CHECK
-    /*
-     * This function was normally unimplemented on Unix platforms and this
-     * implements old behavior, i.e. no stack checking performed.
-     */
-
-    return 1;
-#else
-    int localInt, *stackBound;
-
-    TclpGetCStackParams(&stackBound);
-
-    if (stackGrowsDown) {
-	return (&localInt < stackBound) ;
-    } else {
-	return (&localInt > stackBound) ;
-    }
-#endif
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * TclpGetStackParams --
  *
  *	Determine the stack params for the current thread: in which
@@ -1074,15 +1025,13 @@ TclpCheckStackSpace(void)
  *----------------------------------------------------------------------
  */
 
+#ifndef TCL_NO_STACK_CHECK
 int
 TclpGetCStackParams(
-    int **stackBoundPtr)
+    int ***stackBoundPtr)
 {
-#ifdef TCL_NO_STACK_CHECK
-    *stackBoundPtr = NULL;
-    return 0;
-#else
     int localVar;
+    size_t stackSize;		/* The size of the current stack. */
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 				/* Most variables are actually in a
 				 * thread-specific data block to minimise the
@@ -1097,24 +1046,23 @@ TclpGetCStackParams(
     }
 
     /*
-     * The first time through, we record the "outermost" stack frame.
+     * The first time through in a thread: record the "outermost" stack
+     * frame and inquire the OS about the stack size.
      */
 
     if (tsdPtr->outerVarPtr == NULL) {
 	tsdPtr->outerVarPtr = &localVar;
+	tsdPtr->stackDetermineResult = GetStackSize(&stackSize);
     }
 
-    if (tsdPtr->initialised == 0) {
+    if ((stackGrowsDown && (&localVar < tsdPtr->stackBound))
+	    || (!stackGrowsDown && (&localVar > tsdPtr->stackBound))) {
 	/*
-	 * We appear to have not computed the stack size before. Attempt to
-	 * retrieve it from either the current thread or, failing that, the
-	 * process accounting limit. Note that we assume that stack sizes do
-	 * not change throughout the lifespan of the thread/process; this is
-	 * almost always true.
+	 * Stack failure - if we didn't already blow up, we are within the
+	 * safety area. Recheck with the OS in case the stack was grown.
 	 */
 
-	tsdPtr->stackDetermineResult = GetStackSize(&tsdPtr->stackSize);
-	tsdPtr->initialised = 1;
+	tsdPtr->stackDetermineResult = GetStackSize(&stackSize);
     }
 
     if (tsdPtr->stackDetermineResult != TCL_OK) {
@@ -1124,19 +1072,17 @@ TclpGetCStackParams(
 	    case TCL_CONTINUE:
 		STACK_DEBUG(("skipping stack checks with success\n"));
 	}
-	*stackBoundPtr = NULL;
-	return 1; /* so that check always succeeds */
-    }
-
-    if (stackGrowsDown) {
-	*stackBoundPtr = (int *) ((char *)tsdPtr->outerVarPtr -
-		tsdPtr->stackSize);
+	stackGrowsDown = 1;
+	tsdPtr->stackBound = NULL;
+    } else if (stackGrowsDown) {
+	tsdPtr->stackBound = (int *) ((char *)tsdPtr->outerVarPtr -
+		stackSize);
     } else {
-	*stackBoundPtr = (int *) ((char *)tsdPtr->outerVarPtr +
-		tsdPtr->stackSize);
+	tsdPtr->stackBound = (int *) ((char *)tsdPtr->outerVarPtr +
+		stackSize);
     }
+    *stackBoundPtr = &(tsdPtr->stackBound);
     return stackGrowsDown;
-#endif
 }
 
 int
@@ -1146,6 +1092,8 @@ StackGrowsDown(
     int here;
     return (&here < parent);
 }
+#endif
+
 
 /*
  *----------------------------------------------------------------------
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
index ce834f0..ca10a30 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -19,7 +19,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclUnixPort.h,v 1.59 2007/11/09 21:35:19 msofer Exp $
+ * RCS: @(#) $Id: tclUnixPort.h,v 1.60 2007/11/10 16:08:10 msofer Exp $
  */
 
 #ifndef _TCLUNIXPORT
@@ -679,7 +679,4 @@ MODULE_SCOPE struct group*   TclpGetGrGid(gid_t gid);
 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 */
diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c
index c196705..8ffb697 100644
--- a/win/tclWin32Dll.c
+++ b/win/tclWin32Dll.c
@@ -10,11 +10,22 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWin32Dll.c,v 1.48 2005/11/04 00:06:50 dkf Exp $
+ * RCS: @(#) $Id: tclWin32Dll.c,v 1.49 2007/11/10 16:08:10 msofer Exp $
  */
 
 #include "tclWinInt.h"
 
+#ifndef TCL_NO_STACK_CHECK
+/*
+ * The following functions implement stack depth checking
+ */
+typedef struct ThreadSpecificData {
+    int *stackBound;            /* The current stack boundary */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+static int * CheckStackSpace(void)
+#endif /* TCL_NO_STACK_CHECK */
+
 /*
  * The following data structures are used when loading the thunking library
  * for execing child processes under Win32s.
@@ -511,16 +522,18 @@ TclWinNoBackslash(
     return path;
 }
 
+#ifndef TCL_NO_STACK_CHECK
 /*
  *----------------------------------------------------------------------
  *
- * TclpCheckStackSpace --
+ * CheckStackSpace --
  *
  *	Detect if we are about to blow the stack. Called before an evaluation
  *	can happen when nesting depth is checked.
  *
  * Results:
- *	1 if there is enough stack space to continue; 0 if not.
+ *      A pointer to the deepest safe stack location that was determined, or
+ *      NULL if we are about to blow the stack.
  *
  * Side effects:
  *	None.
@@ -528,8 +541,8 @@ TclWinNoBackslash(
  *----------------------------------------------------------------------
  */
 
-int
-TclpCheckStackSpace(void)
+static int *
+CheckStackSpace(void)
 {
 
 #ifdef HAVE_NO_SEH
@@ -633,8 +646,79 @@ TclpCheckStackSpace(void)
     } __except (EXCEPTION_EXECUTE_HANDLER) {}
 #endif /* HAVE_NO_SEH */
 
-    return retval;
+    if (retval) {
+	return (int *) ((char *)&retval - TCL_WIN_STACK_THRESHOLD);
+    } else {
+	return NULL;
+    }
 }
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetStackParams --
+ *
+ *	Determine the 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifndef TCL_NO_STACK_CHECK
+int
+TclpGetCStackParams(
+    int ***stackBoundPtr)
+{
+    int localVar, *stackBound;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+				/* Most variables are actually in a
+				 * thread-specific data block to minimise the
+				 * impact on the stack. */
+
+    if (!tsdPtr->stackBound || (&localVar < tsdPtr->stackBound)) {
+	/*
+	 * First time through in this thread or apparent stack failure. If we
+	 * didn't already blow up, we are within the safety area. Recheck with
+	 * the OS to get a new estimate.
+	 */
+	
+	stackBound = CheckStackSpace();
+	if (!stackBound) {
+	    /*
+	     * We are really blowing the stack! Do not update the estimate we 
+	     * already had, just return.
+	     */
+	    
+	    if (!tsdPtr->stackBound) {
+		/*
+		 * ??? First time around: this thread was born with a stack
+		 * smaller than TCL_WIN_STACK_THRESHOLD. What do we do now?
+		 * Initialise to something that will always fail? Choose for
+		 * instance 1K ints above the current depth.
+		 */
+		
+		tsdPtr->stackBound = (&localVar + 1024);
+	    }
+	} else {
+	    tsdPtr->stackBound = stackBound;
+	}
+    }
+    
+    *stackBoundPtr = &(tsdPtr->stackBound);
+    return 1;
+}
+#endif
+
 
 /*
  *---------------------------------------------------------------------------