Index: tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.456
diff -c -r1.456 tclBasic.c
*** tclBasic.c	3 May 2010 14:36:41 -0000	1.456
--- tclBasic.c	28 May 2010 12:46:05 -0000
***************
*** 85,101 ****
  
  static const CorContext NULL_CONTEXT = {NULL, NULL, NULL, NULL};
  
  #define SAVE_CONTEXT(context)				\
      (context).framePtr = iPtr->framePtr;		\
      (context).varFramePtr = iPtr->varFramePtr;		\
      (context).cmdFramePtr = iPtr->cmdFramePtr;		\
!     (context).lineLABCPtr = iPtr->lineLABCPtr
  
  #define RESTORE_CONTEXT(context)			\
      iPtr->framePtr = (context).framePtr;		\
      iPtr->varFramePtr = (context).varFramePtr;		\
      iPtr->cmdFramePtr = (context).cmdFramePtr;		\
!     iPtr->lineLABCPtr = (context).lineLABCPtr
  
  /*
   * Static functions in this file:
--- 85,112 ----
  
  static const CorContext NULL_CONTEXT = {NULL, NULL, NULL, NULL};
  
+ void checkstack (char *header, CallFrame *stack) {
+     fprintf(stderr, "%s :", header);
+     while (stack != NULL) {
+         fprintf(stderr, " %p", stack);
+         stack = stack->callerPtr;
+     }
+     fprintf(stderr, "\n");
+ }
+ 
  #define SAVE_CONTEXT(context)				\
+     checkstack("SAVE", iPtr->framePtr); \
      (context).framePtr = iPtr->framePtr;		\
      (context).varFramePtr = iPtr->varFramePtr;		\
      (context).cmdFramePtr = iPtr->cmdFramePtr;		\
!     (context).lineLABCPtr = iPtr->lineLABCPtr;
  
  #define RESTORE_CONTEXT(context)			\
      iPtr->framePtr = (context).framePtr;		\
+     checkstack("RESTORE", iPtr->framePtr);              \
      iPtr->varFramePtr = (context).varFramePtr;		\
      iPtr->cmdFramePtr = (context).cmdFramePtr;		\
!     iPtr->lineLABCPtr = (context).lineLABCPtr;
  
  /*
   * Static functions in this file:
***************
*** 1458,1463 ****
--- 1469,1475 ----
      if (iPtr->framePtr != iPtr->rootFramePtr) {
  	Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top");
      }
+     fprintf(stderr, "DeleteInterpProc: ");
      Tcl_PopCallFrame(interp);
      ckfree((char *) iPtr->rootFramePtr);
      iPtr->rootFramePtr = NULL;
***************
*** 6567,6580 ****
       * Make the specified namespace the current namespace and invoke the
       * command.
       */
! 
      result = TclPushStackFrame(interp, &framePtr, nsPtr, /*isProcFrame*/0);
      if (result != TCL_OK) {
  	return TCL_ERROR;
      }
  
      result = TclObjInvoke(interp, objc, objv, flags);
! 
      TclPopStackFrame(interp);
      return result;
  }
--- 6579,6592 ----
       * Make the specified namespace the current namespace and invoke the
       * command.
       */
!     fprintf(stderr, "TclObjInvokeNamespace: ");
      result = TclPushStackFrame(interp, &framePtr, nsPtr, /*isProcFrame*/0);
      if (result != TCL_OK) {
  	return TCL_ERROR;
      }
  
      result = TclObjInvoke(interp, objc, objv, flags);
!     fprintf(stderr, "TclObjInvokeNamespace: ");
      TclPopStackFrame(interp);
      return result;
  }
***************
*** 8668,8674 ****
--- 8680,8688 ----
      }
  
      NRE_ASSERT(COR_IS_SUSPENDED(corPtr));
+     fprintf(stderr, "NRCoroutineCallerCallback save running: %p\n", corPtr);
      SAVE_CONTEXT(corPtr->running);
+     fprintf(stderr, "NRCoroutineCallerCallback restore caller: %p\n", corPtr);
      RESTORE_CONTEXT(corPtr->caller);
  
      if (cmdPtr->flags & CMD_IS_DELETED) {
***************
*** 8678,8683 ****
--- 8692,8698 ----
  	 * restore both the caller's context and interp state.
  	 */
  
+         fprintf(stderr, "NRCoroutineCallerCallback rewind: %p\n", corPtr);
  	return RewindCoroutine(corPtr, result);
      }
  
***************
*** 8713,8718 ****
--- 8728,8734 ----
      TclDeleteExecEnv(corPtr->eePtr);
      corPtr->eePtr = NULL;
  
+     fprintf(stderr, "NRCoroutineExitCallback restore caller %p\n", corPtr);
      RESTORE_CONTEXT(corPtr->caller);
  
      NRE_ASSERT(iPtr->framePtr == corPtr->caller.framePtr);
***************
*** 8789,8795 ****
--- 8805,8813 ----
       * the codePtr will be read from the execEnv's saved bottomPtr.
       */
  
+     fprintf(stderr, "NRInterpCoroutine save caller: %p\n", corPtr);
      SAVE_CONTEXT(corPtr->caller);
+     fprintf(stderr, "NRInterpCoroutine restore running: %p\n", corPtr);
      RESTORE_CONTEXT(corPtr->running);
      corPtr->auxNumLevels = iPtr->numLevels;
      iPtr->numLevels += nestNumLevels;
***************
*** 8861,8866 ****
--- 8879,8885 ----
      corPtr = (CoroutineData *) ckalloc(sizeof(CoroutineData));
      TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, NULL, NULL,
  	    NULL);
+     fprintf(stderr, "TclNRCoroutineObjCmd save caller: %p\n", corPtr);
      SAVE_CONTEXT(corPtr->caller);
  
      /*
Index: tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.482
diff -c -r1.482 tclExecute.c
*** tclExecute.c	30 Apr 2010 08:29:40 -0000	1.482
--- tclExecute.c	28 May 2010 12:46:08 -0000
***************
*** 1225,1235 ****
  {
      Interp *iPtr = (Interp *) interp;
      int numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
! 
      if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
  	return (void *) Tcl_Alloc(numBytes);
      }
! 
      return (void *) StackAllocWords(interp, numWords);
  }
  
--- 1225,1235 ----
  {
      Interp *iPtr = (Interp *) interp;
      int numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
!     void *result;
      if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
  	return (void *) Tcl_Alloc(numBytes);
      }
!     
      return (void *) StackAllocWords(interp, numWords);
  }
  
Index: tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.205
diff -c -r1.205 tclNamesp.c
*** tclNamesp.c	5 Apr 2010 19:44:45 -0000	1.205
--- tclNamesp.c	28 May 2010 12:46:10 -0000
***************
*** 322,327 ****
--- 322,329 ----
  
      iPtr->framePtr = framePtr;
      iPtr->varFramePtr = framePtr;
+     checkstack("PUSH", framePtr);
+ 
      return TCL_OK;
  }
  
***************
*** 360,366 ****
--- 362,370 ----
  
      if (framePtr->callerPtr) {
  	iPtr->framePtr = framePtr->callerPtr;
+         checkstack("POP", iPtr->framePtr);
  	iPtr->varFramePtr = framePtr->callerVarPtr;
+         framePtr->callerPtr= (void*)-1;
      } else {
  	/* Tcl_PopCallFrame: trying to pop rootCallFrame! */
      }
***************
*** 441,448 ****
--- 445,455 ----
      Tcl_Interp *interp)		/* Interpreter with call frame to pop. */
  {
      CallFrame *freePtr = ((Interp *) interp)->framePtr;
+     CallFrame *rootPtr = ((Interp *) interp)->rootFramePtr;
  
+     fprintf(stderr, "DELETING %p ", freePtr);
      Tcl_PopCallFrame(interp);
+     freePtr->callerPtr = (void*)-9;	/* flag deleted frame */
      TclStackFree(interp, freePtr);
  }
  
***************
*** 2225,2235 ****
--- 2232,2244 ----
  	    } else if (flags & TCL_CREATE_NS_IF_UNKNOWN) {
  		Tcl_CallFrame *framePtr;
  
+                 fprintf(stderr, "TclGetNamespaceForQualName: ");
  		(void) TclPushStackFrame(interp, &framePtr,
  			(Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0);
  
  		nsPtr = (Namespace *)
  			Tcl_CreateNamespace(interp, nsName, NULL, NULL);
+                 fprintf(stderr, "TclGetNamespaceForQualName: ");
  		TclPopStackFrame(interp);
  
  		if (nsPtr == NULL) {
***************
*** 3336,3341 ****
--- 3345,3351 ----
  
      /* This is needed to satisfy GCC 3.3's strict aliasing rules */
      framePtrPtr = &framePtr;
+     fprintf(stderr, "NamespaceEvalCmd: ");
      result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
  	    namespacePtr, /*isProcCallFrame*/ 0);
      if (result != TCL_OK) {
***************
*** 3400,3405 ****
--- 3410,3416 ----
       * Restore the previous "current" namespace.
       */
  
+     fprintf(stderr, "NsEval_Callback: ");
      TclPopStackFrame(interp);
      return result;
  }
***************
*** 3781,3786 ****
--- 3792,3798 ----
  
      framePtrPtr = &framePtr;		/* This is needed to satisfy GCC's
  					 * strict aliasing rules. */
+     fprintf(stderr, "NamespaceInscopeCmd: ");
      result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
  	    namespacePtr, /*isProcCallFrame*/ 0);
      if (result != TCL_OK) {
Index: tclOOBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclOOBasic.c,v
retrieving revision 1.24
diff -c -r1.24 tclOOBasic.c
*** tclOOBasic.c	5 Feb 2010 13:41:33 -0000	1.24
--- tclOOBasic.c	28 May 2010 12:46:10 -0000
***************
*** 344,349 ****
--- 344,350 ----
       * command(s).
       */
  
+     fprintf(stderr, "TclOO_Object_Eval: ");
      result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
  	    Tcl_GetObjectNamespace(object), 0);
      if (result != TCL_OK) {
***************
*** 407,412 ****
--- 408,414 ----
       * Restore the previous "current" namespace.
       */
  
+     fprintf(stderr, "FinalizeEval: ");
      TclPopStackFrame(interp);
      return result;
  }
***************
*** 628,637 ****
--- 630,641 ----
      if (iPtr->varFramePtr == NULL) {
  	Tcl_CallFrame *dummyFrame;
  
+ 	fprintf(stderr, "TclOO_Object_VarName: ");
  	TclPushStackFrame(interp, &dummyFrame,
  		Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context)),0);
  	varPtr = TclObjLookupVar(interp, objv[objc-1], NULL,
  		TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG, "refer to",1,1,&aryVar);
+     fprintf(stderr, "FinalizeEval: ");
  	TclPopStackFrame(interp);
      } else {
  	Namespace *savedNsPtr;
Index: tclOODefineCmds.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclOODefineCmds.c,v
retrieving revision 1.13
diff -c -r1.13 tclOODefineCmds.c
*** tclOODefineCmds.c	5 Mar 2010 11:36:19 -0000	1.13
--- tclOODefineCmds.c	28 May 2010 12:46:11 -0000
***************
*** 573,578 ****
--- 573,579 ----
  
      /* framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules */
  
+     fprintf(stderr, "InitDefineContext: ");
      result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
  	    namespacePtr, FRAME_IS_OO_DEFINE);
      if (result != TCL_OK) {
***************
*** 771,776 ****
--- 772,778 ----
       * Restore the previous "current" namespace.
       */
  
+     fprintf(stderr, "TclOODefineObjCmd: ");
      TclPopStackFrame(interp);
      return result;
  }
***************
*** 890,895 ****
--- 892,898 ----
       * Restore the previous "current" namespace.
       */
  
+     fprintf(stderr, "TclOOObjDefObjCmd: ");
      TclPopStackFrame(interp);
      return result;
  }
***************
*** 1010,1015 ****
--- 1013,1019 ----
       * Restore the previous "current" namespace.
       */
  
+     fprintf(stderr, "TclOODefineSelfObjCmd: ");
      TclPopStackFrame(interp);
      return result;
  }
Index: tclOOMethod.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclOOMethod.c,v
retrieving revision 1.26
diff -c -r1.26 tclOOMethod.c
*** tclOOMethod.c	24 Mar 2010 13:21:11 -0000	1.26
--- tclOOMethod.c	28 May 2010 12:46:11 -0000
***************
*** 711,717 ****
--- 711,720 ----
  	result = pmPtr->preCallProc(pmPtr->clientData, interp, context,
  		(Tcl_CallFrame *) fdPtr->framePtr, &isFinished);
  	if (isFinished || result != TCL_OK) {
+ 	    fprintf(stderr, "InvokeProcedureMethod: ");
  	    Tcl_PopCallFrame(interp);
+ 	    fprintf(stderr, "InvokeProcedureMethod DELETING %p\n", fdPtr->framePtr);
+ 	    fdPtr->framePtr->callerPtr = (void*)-3;	/* flag deleted frame */
  	    TclStackFree(interp, fdPtr->framePtr);
  	    if (--pmPtr->refCount < 1) {
  		DeleteProcedureMethodRecord(pmPtr);
***************
*** 853,858 ****
--- 856,862 ----
       * This operation may fail.
       */
  
+     fprintf(stderr, "PushMethodCallFrame: ");
      result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
  	    (Tcl_Namespace *) nsPtr, FRAME_IS_PROC|FRAME_IS_METHOD);
      if (result != TCL_OK) {
Index: tclObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclObj.c,v
retrieving revision 1.173
diff -c -r1.173 tclObj.c
*** tclObj.c	27 Apr 2010 12:36:21 -0000	1.173
--- tclObj.c	28 May 2010 12:46:13 -0000
***************
*** 4134,4154 ****
       */
  
      resPtr = objPtr->internalRep.twoPtrValue.ptr1;
!     if ((objPtr->typePtr == &tclCmdNameType) && (resPtr != NULL)) {
!         register Command *cmdPtr = resPtr->cmdPtr;
  
!         if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch)
                  && !(cmdPtr->flags & CMD_IS_DELETED)
                  && (interp == cmdPtr->nsPtr->interp)
                  && !(cmdPtr->nsPtr->flags & NS_DYING)) {
!             register Namespace *refNsPtr = (Namespace *)
                      TclGetCurrentNamespace(interp);
! 
!             if ((resPtr->refNsPtr == NULL)
!                 || ((refNsPtr == resPtr->refNsPtr)
!                     && (resPtr->refNsId == refNsPtr->nsId)
!                     && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) {
!                 return (Tcl_Command) cmdPtr;
              }
          }
      }
--- 4134,4156 ----
       */
  
      resPtr = objPtr->internalRep.twoPtrValue.ptr1;
!     if ((objPtr->typePtr == &tclCmdNameType)) {
!         if (resPtr != NULL) {
!             register Command *cmdPtr = resPtr->cmdPtr;
  
!             if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch)
                  && !(cmdPtr->flags & CMD_IS_DELETED)
                  && (interp == cmdPtr->nsPtr->interp)
                  && !(cmdPtr->nsPtr->flags & NS_DYING)) {
!                 register Namespace *refNsPtr = (Namespace *)
                      TclGetCurrentNamespace(interp);
!                 
!                 if ((resPtr->refNsPtr == NULL)
!                     || ((refNsPtr == resPtr->refNsPtr)
!                         && (resPtr->refNsId == refNsPtr->nsId)
!                         && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) {
!                     return (Tcl_Command) cmdPtr;
!                 }
              }
          }
      }
***************
*** 4374,4390 ****
      if (cmdPtr) {
  	cmdPtr->refCount++;
  	resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
! 	if ((objPtr->typePtr == &tclCmdNameType)
! 		&& resPtr && (resPtr->refCount == 1)) {
! 	    /*
! 	     * Reuse the old ResolvedCmdName struct instead of freeing it
! 	     */
! 
! 	    Command *oldCmdPtr = resPtr->cmdPtr;
! 
! 	    if (--oldCmdPtr->refCount == 0) {
! 		TclCleanupCommandMacro(oldCmdPtr);
! 	    }
  	} else {
  	    TclFreeIntRep(objPtr);
  	    resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
--- 4376,4400 ----
      if (cmdPtr) {
  	cmdPtr->refCount++;
  	resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
! 	if ((objPtr->typePtr == &tclCmdNameType)) {
!             if (resPtr && (resPtr->refCount == 1)) {
!                 /*
!                  * Reuse the old ResolvedCmdName struct instead of freeing it
!                  */
! 
!                 Command *oldCmdPtr = resPtr->cmdPtr;
!                 
!                 if (--oldCmdPtr->refCount == 0) {
!                     TclCleanupCommandMacro(oldCmdPtr);
!                 }
!             } else {
!                 TclFreeIntRep(objPtr);
!                 resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
!                 resPtr->refCount = 1;
!                 objPtr->internalRep.twoPtrValue.ptr1 = resPtr;
!                 objPtr->internalRep.twoPtrValue.ptr2 = NULL;
!                 objPtr->typePtr = &tclCmdNameType;
!             }
  	} else {
  	    TclFreeIntRep(objPtr);
  	    resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
Index: tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.179
diff -c -r1.179 tclProc.c
*** tclProc.c	5 Mar 2010 14:34:04 -0000	1.179
--- tclProc.c	28 May 2010 12:46:14 -0000
***************
*** 1640,1645 ****
--- 1640,1646 ----
       */
  
      framePtrPtr = &framePtr;
+     fprintf(stderr, "PushProcCallFrame: ");
      result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
  	    (Tcl_Namespace *) nsPtr,
  	    (isLambda? (FRAME_IS_PROC|FRAME_IS_LAMBDA) : FRAME_IS_PROC));
***************
*** 1744,1752 ****
--- 1745,1756 ----
      result = InitArgsAndLocals(interp, procNameObj, skip);
      if (result != TCL_OK) {
  	freePtr = iPtr->framePtr;
+ 	fprintf(stderr, "TclNRInterpProcCore: ");
  	Tcl_PopCallFrame(interp);	/* Pop but do not free. */
  	TclStackFree(interp, freePtr->compiledLocals);
  					/* Free compiledLocals. */
+ 	fprintf(stderr, "TclNRInterpProcCore: DELETING %p\n", freePtr);
+ 	freePtr->callerPtr=(void*)-5;
  	TclStackFree(interp, freePtr);	/* Free CallFrame. */
  	return TCL_ERROR;
      }
***************
*** 1908,1916 ****
--- 1912,1923 ----
       */
  
      freePtr = iPtr->framePtr;
+     fprintf(stderr, "InterpProcNR2: ");
      Tcl_PopCallFrame(interp);		/* Pop but do not free. */
      TclStackFree(interp, freePtr->compiledLocals);
  					/* Free compiledLocals. */
+     fprintf(stderr, "InterpProcNR2: DELETING %p\n", freePtr);
+     freePtr->callerPtr = (void*)-7;	/* flag deleted frame */
      TclStackFree(interp, freePtr);	/* Free CallFrame. */
  
      return result;
***************
*** 2044,2049 ****
--- 2051,2057 ----
  	    procPtr->numCompiledLocals = procPtr->numArgs;
  	}
  
+     fprintf(stderr, "TclProcCompileProc: ");
  	TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr,
  		/* isProcCallFrame */ 0);
  
***************
*** 2062,2067 ****
--- 2070,2076 ----
  	iPtr->invokeCmdFramePtr = (hePtr ? Tcl_GetHashValue(hePtr) : NULL);
  	tclByteCodeType.setFromAnyProc(interp, bodyPtr);
  	iPtr->invokeCmdFramePtr = NULL;
+ 	fprintf(stderr, "TclProcCompileProc: ");
  	TclPopStackFrame(interp);
      } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) {
  	/*
***************
*** 2881,2886 ****
--- 2890,2896 ----
  	if (result != TCL_OK) {
  	    return result;
  	}
+ 	fprintf(stderr, "Tcl_DisassembleObjCmd: ");
  	TclPopStackFrame(interp);
  	codeObjPtr = procPtr->bodyPtr;
  	break;
***************
*** 2905,2910 ****
--- 2915,2921 ----
  	    if (result != TCL_OK) {
  		return result;
  	    }
+ 	    fprintf(stderr, "Tcl_DisassembleObjCmd: ");
  	    TclPopStackFrame(interp);
  	    codeObjPtr = procPtr->bodyPtr;
  	    break;
