Tcl Source Code

Artifact [098b650ac7]
Login

Artifact 098b650ac7606d4fdb03951a01a7d77e33a435cf:

Attachment "stackcheck2.patch" to ticket [3008307fff] added by ferrieux 2010-05-31 05:37:56.
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	30 May 2010 22:36:07 -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	30 May 2010 22:36:15 -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,24 @@ 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 : frame=%p  gc=%d cgc=%d c->gc=%d !!!",
+                          frame,
+                          frame->genCount,
+                          frame->callerGenCount,
+                          frame->callerPtr->genCount);
+        }
+}
+
 /*
  *----------------------------------------------------------------------
  *
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	30 May 2010 22:36:25 -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	30 May 2010 22:36:25 -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);
@@ -391,6 +395,7 @@ Tcl_PopCallFrame(
 	Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
     }
     framePtr->nsPtr = NULL;
+    framePtr->genCount = -1;
 }
 
 /*