Tcl Source Code

Artifact 6a002f0041cb6026f63f3b0f83cfc9804a417ca5:

Attachment "stackcheck.patch" to ticket [3008307fff] added by ferrieux 2010-05-30 05:56:11.

---

Index: generic/tcl.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
retrieving revision 1.306
diff -u -p -r1.306 tcl.h
--- generic/tcl.h	30 Apr 2010 21:15:42 -0000	1.306
+++ generic/tcl.h	29 May 2010 22:52:13 -0000
@@ -887,6 +887,8 @@ typedef struct Tcl_Namespace {
 
 typedef struct Tcl_CallFrame {
     Tcl_Namespace *nsPtr;
+    int dummyA;
+    int dummyB;
     int dummy1;
     int dummy2;
     void *dummy3;
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.456
diff -u -p -r1.456 tclBasic.c
--- generic/tclBasic.c	3 May 2010 14:36:41 -0000	1.456
+++ generic/tclBasic.c	29 May 2010 22:52:22 -0000
@@ -92,7 +92,7 @@ static const CorContext NULL_CONTEXT = {
     (context).lineLABCPtr = iPtr->lineLABCPtr
 
 #define RESTORE_CONTEXT(context)			\
-    iPtr->framePtr = (context).framePtr;		\
+    iPtr->framePtr = (context).framePtr; CheckStackSanity(iPtr->framePtr); \
     iPtr->varFramePtr = (context).varFramePtr;		\
     iPtr->cmdFramePtr = (context).cmdFramePtr;		\
     iPtr->lineLABCPtr = (context).lineLABCPtr
@@ -399,6 +399,20 @@ static const OpCmdInfo mathOpCmds[] = {
 		{0},			NULL}
 };
 
+
+
+
+static void CheckStackSanity(CallFrame *iniframe)
+{
+    CallFrame *frame;
+
+    for(frame = iniframe ; frame ; frame = frame->callerPtr)
+        {
+            if (frame->callerPtr && (frame->callerGenCount != frame->callerPtr->genCount))
+                Tcl_Panic("Insane Stack !!!");
+        }
+}
+
 /*
  *----------------------------------------------------------------------
  *
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.477
diff -u -p -r1.477 tclInt.h
--- generic/tclInt.h	28 May 2010 13:52:00 -0000	1.477
+++ generic/tclInt.h	29 May 2010 22:52:28 -0000
@@ -1101,6 +1101,7 @@ MODULE_SCOPE void	TclFreeLocalCache(Tcl_
 typedef struct CallFrame {
     Namespace *nsPtr;		/* Points to the namespace used to resolve
 				 * commands and global variables. */
+    int genCount, callerGenCount;
     int isProcCallFrame;	/* If 0, the frame was pushed to execute a
 				 * namespace command and var references are
 				 * treated as references to namespace vars;
Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.205
diff -u -p -r1.205 tclNamesp.c
--- generic/tclNamesp.c	5 Apr 2010 19:44:45 -0000	1.205
+++ generic/tclNamesp.c	29 May 2010 22:52:33 -0000
@@ -138,6 +138,8 @@ static void		UnlinkNsPath(Namespace *nsP
 
 static Tcl_NRPostProc NsEval_Callback;
 
+static int gencount=0;
+
 /*
  * This structure defines a Tcl object type that contains a namespace
  * reference. It is used in commands that take the name of a namespace as an
@@ -301,6 +303,8 @@ Tcl_PushCallFrame(
     framePtr->objc = 0;
     framePtr->objv = NULL;
     framePtr->callerPtr = iPtr->framePtr;
+    if (iPtr->framePtr) framePtr->callerGenCount = iPtr->framePtr->genCount;
+    framePtr->genCount = gencount++;
     framePtr->callerVarPtr = iPtr->varFramePtr;
     if (iPtr->varFramePtr != NULL) {
 	framePtr->level = (iPtr->varFramePtr->level + 1);