Attachment "framedebug.patch" to
ticket [3008307fff]
added by
coldstore
2010-05-28 19:49:25.
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;
