Index: generic/xotcl.c =================================================================== diff -u -rfa7bc22b99d66e75f67999d3b153d38f024c1be7 -rae922ee26ff2c658d5d0c3b8b98b71ab2f8bb4f9 --- generic/xotcl.c (.../xotcl.c) (revision fa7bc22b99d66e75f67999d3b153d38f024c1be7) +++ generic/xotcl.c (.../xotcl.c) (revision ae922ee26ff2c658d5d0c3b8b98b71ab2f8bb4f9) @@ -647,19 +647,27 @@ }*/ framePtr = (Tcl_CallFrame *)Tcl_Interp_framePtr(interp); for (; framePtr; framePtr = Tcl_CallFrame_callerPtr(framePtr)) { - fprintf(stderr, "... var frame %p flags %.6x cd %p lvl %d ns %p %s objv[0] %s\n", + fprintf(stderr, "... var frame %p flags %.6x cd %.8x lvl %d frameType %d ns %p %s objv[0] %s\n", framePtr, Tcl_CallFrame_isProcCallFrame(framePtr), - Tcl_CallFrame_clientData(framePtr), + (int)Tcl_CallFrame_clientData(framePtr), Tcl_CallFrame_level(framePtr), + Tcl_CallFrame_isProcCallFrame(framePtr) & (FRAME_IS_XOTCL_METHOD|FRAME_IS_XOTCL_CMETHOD) + ? ((XOTclCallStackContent *)Tcl_CallFrame_clientData(framePtr))->frameType : -1, Tcl_CallFrame_nsPtr(framePtr), Tcl_CallFrame_nsPtr(framePtr)->fullName, Tcl_CallFrame_objc(framePtr) ? ObjStr(Tcl_CallFrame_objv(framePtr)[0]) : "(null)"); } } Tcl_CallFrame * nonXotclObjectProcFrame(Tcl_CallFrame *framePtr) { for (; framePtr; framePtr = Tcl_CallFrame_callerPtr(framePtr)) { - if (Tcl_CallFrame_isProcCallFrame(framePtr) & FRAME_IS_PROC) break; - if ((Tcl_CallFrame_isProcCallFrame(framePtr) & (FRAME_IS_XOTCL_OBJECT|FRAME_IS_XOTCL_CMETHOD)) == 0) break; + int flag = Tcl_CallFrame_isProcCallFrame(framePtr); + if (flag & FRAME_IS_XOTCL_METHOD) { + /* never return an inactive method frame */ + if (!(((XOTclCallStackContent *)Tcl_CallFrame_clientData(framePtr))->frameType & XOTCL_CSC_TYPE_INACTIVE)) break; + } else { + if ((flag & (FRAME_IS_XOTCL_OBJECT|FRAME_IS_XOTCL_CMETHOD)) == 0) break; + if (flag & FRAME_IS_PROC) break; + } } return framePtr; } @@ -2401,75 +2409,6 @@ } static void -CallStackUseActiveFrames(Tcl_Interp *interp, callFrameContext *ctx) { - XOTclCallStackContent *active, *top = RUNTIME_STATE(interp)->cs.top; - Tcl_CallFrame *inFramePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp), *varFramePtr = inFramePtr; - - active = XOTclCallStackFindActiveFrame(interp, 0); -#if defined(TCL85STACK) -# if defined(TCL85STACK_TRACE) - for (varFramePtr = inFramePtr; varFramePtr; varFramePtr = Tcl_CallFrame_callerPtr(varFramePtr)) { - fprintf(stderr, "check frame %p flags %.6x cd %p objv[0] %s\n", - varFramePtr, Tcl_CallFrame_isProcCallFrame(varFramePtr), - Tcl_CallFrame_clientData(varFramePtr), - Tcl_CallFrame_objc(varFramePtr) ? ObjStr(Tcl_CallFrame_objv(varFramePtr)[0]) : "(null)"); - } -# endif - /* Get the first non object frame (or object frame with proc; TODO: think about it) */ - varFramePtr = nonXotclObjectProcFrame(inFramePtr); -#endif - - /*fprintf(stderr,"active %p, top %p, varFrame(interp) %p, topVarFrame %p, active->curr %p\n", - active, top, inFramePtr, top->currentFramePtr, - active? active->currentFramePtr : NULL);*/ - - if (active == top || inFramePtr == NULL || Tcl_CallFrame_level(inFramePtr) == 0) { - /* top frame is a active frame, or we could not find a calling - frame */ - if (inFramePtr == varFramePtr) { - /* call frame pointers are fine */ - /*fprintf(stderr, "... no need to save frames\n");*/ - ctx->framesSaved = 0; - } else { - /*fprintf(stderr, "... save since we skipped OBJECT frame\n");*/ - ctx->varFramePtr = inFramePtr; - Tcl_Interp_varFramePtr(interp) = (CallFrame *)varFramePtr; - ctx->framesSaved = 1; - } - } else if (active == NULL) { - Tcl_CallFrame *cf = inFramePtr; - /*fprintf(stderr,"active == NULL\n"); */ - /* find a proc frame, which is not equal the top level cmd */ - /* XOTclStackDump(interp);*/ - for (; cf && Tcl_CallFrame_level(cf); cf = Tcl_CallFrame_callerPtr(cf)) { - if (Tcl_CallFrame_isProcCallFrame(cf) && cf != top->currentFramePtr) - break; - } - /*fprintf(stderr, "... save frame with top proc, varFrame %p callframe %p\n",cf,inFramePtr);*/ - ctx->varFramePtr = inFramePtr; - Tcl_Interp_varFramePtr(interp) = (CallFrame *)cf; - ctx->framesSaved = 1; - } else { - Tcl_CallFrame *framePtr; - /*fprintf(stderr,"active == deeper active=%p frame %p, active+1 %p frame %p\n", - active, active->currentFramePtr, - active+1, (active+1)->currentFramePtr);*/ - /* search returned a deeper pointer, use stored tcl frame pointers; - If Tcl is mixed with XOTcl it is needed to use instead of - active->currentFrame the callerPtr of the last inactive frame - unless the last inactive is NULL */ - if ((framePtr = (active+1)->currentFramePtr)) - framePtr = Tcl_CallFrame_callerPtr(framePtr); - else - framePtr = active->currentFramePtr; - /*fprintf(stderr, "... save frame from deeper active frame, varFrame %p callframe %p\n",inFramePtr,framePtr);*/ - ctx->varFramePtr = inFramePtr; - Tcl_Interp_varFramePtr(interp) = (CallFrame *)framePtr; - ctx->framesSaved = 1; - } -} - -static void CallStackRestoreSavedFrames(Tcl_Interp *interp, callFrameContext *ctx) { if (ctx->framesSaved) { Tcl_Interp_varFramePtr(interp) = (CallFrame *)ctx->varFramePtr; @@ -6689,7 +6628,7 @@ SetProcDefault(Tcl_Interp *interp, Tcl_Obj *var, Tcl_Obj *defVal) { int result = TCL_OK; callFrameContext ctx = {0}; - CallStackUseActiveFrames(interp,&ctx); + CallStackUseActiveFrames(interp,&ctx, 1); if (defVal) { if (Tcl_ObjSetVar2(interp, var, NULL, defVal, 0)) { @@ -7106,7 +7045,7 @@ switch (level) { case CALLING_LEVEL: csc = XOTclCallStackFindLastInvocation(interp, 1); break; - case ACTIVE_LEVEL: csc = XOTclCallStackFindActiveFrame(interp, 1); break; + case ACTIVE_LEVEL: csc = XOTclCallStackFindActiveFrame(interp, 1, NULL /*todo*/); break; default: csc = NULL; } @@ -10694,7 +10633,7 @@ callFrameContext ctx = {0}; if (obj && (obj->filterStack || obj->mixinStack) ) { - CallStackUseActiveFrames(interp, &ctx); + CallStackUseActiveFrames(interp, &ctx, 2); } if (!Tcl_Interp_varFramePtr(interp)) { CallStackRestoreSavedFrames(interp, &ctx); @@ -11068,7 +11007,7 @@ } if (obj && (obj->filterStack || obj->mixinStack)) { - CallStackUseActiveFrames(interp, &ctx); + CallStackUseActiveFrames(interp, &ctx, 3); } for ( ; i < objc; i += 2) { @@ -11097,7 +11036,7 @@ return XOTclVarErrMsg(interp, "Can't make objects volatile during shutdown\n", NULL); } - CallStackUseActiveFrames(interp, &ctx); + CallStackUseActiveFrames(interp, &ctx, 4); vn = NSTail(fullName); if (Tcl_SetVar2(interp, vn, NULL, fullName, 0)) { Index: generic/xotclStack.c =================================================================== diff -u -rfa7bc22b99d66e75f67999d3b153d38f024c1be7 -rae922ee26ff2c658d5d0c3b8b98b71ab2f8bb4f9 --- generic/xotclStack.c (.../xotclStack.c) (revision fa7bc22b99d66e75f67999d3b153d38f024c1be7) +++ generic/xotclStack.c (.../xotclStack.c) (revision ae922ee26ff2c658d5d0c3b8b98b71ab2f8bb4f9) @@ -66,23 +66,71 @@ } XOTclCallStackContent * -XOTclCallStackFindActiveFrame(Tcl_Interp *interp, int offset) { +XOTclCallStackFindActiveFrame(Tcl_Interp *interp, int offset, Tcl_CallFrame **framePtrPtr) { XOTclCallStack *cs = &RUNTIME_STATE(interp)->cs; register XOTclCallStackContent *csc; /* search for first active frame and set tcl frame pointers */ for (csc=cs->top-offset; csc > cs->content; csc --) { if (!(csc->frameType & XOTCL_CSC_TYPE_INACTIVE)) { /* we found the highest active frame */ + if (framePtrPtr) *framePtrPtr = csc->currentFramePtr; return csc; } } /* we could not find an active frame; called from toplevel? */ + if (framePtrPtr) *framePtrPtr = NULL; return NULL; } +static void +CallStackUseActiveFrames(Tcl_Interp *interp, callFrameContext *ctx, int i) { + XOTclCallStackContent *active, *top; + Tcl_CallFrame *inFramePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp), + *varFramePtr, *activeFramePtr, *framePtr; + active = XOTclCallStackFindActiveFrame(interp, 0, &activeFramePtr); + top = CallStackGetTopFrame(interp); + varFramePtr = inFramePtr; + /*fprintf(stderr,"CallStackUseActiveFrames inframe %p varFrame %p activeFrame %p lvl %d\n", + inFramePtr,varFramePtr,activeFramePtr, Tcl_CallFrame_level(inFramePtr));*/ + + + if (activeFramePtr == varFramePtr || active == top || Tcl_CallFrame_level(inFramePtr) == 0) { + /* top frame is a active frame, or we could not find a calling frame */ + framePtr = varFramePtr; + + } else if (active == NULL) { + /* There is no xotcl callframe active; use the caller of inframe */ + fprintf(stderr,"active == NULL\n"); + for (framePtr = inFramePtr; framePtr && Tcl_CallFrame_level(framePtr); framePtr = Tcl_CallFrame_callerPtr(framePtr)) { + if (framePtr != top->currentFramePtr) + break; + } + } else { + /* The active framePtr is an entry deeper in the stack. When XOTcl + is interleaved with Tcl, we return the Tcl frame */ + + /* fprintf(stderr,"active == deeper, use Tcl frame\n"); */ + if ((framePtr = (active+1)->currentFramePtr)) { + framePtr = Tcl_CallFrame_callerPtr(framePtr); + } else { + framePtr = active->currentFramePtr; + } + } + if (inFramePtr == framePtr) { + /* call frame pointers are fine */ + /*fprintf(stderr, "... no need to save frames\n");*/ + ctx->framesSaved = 0; + } else { + ctx->varFramePtr = inFramePtr; + Tcl_Interp_varFramePtr(interp) = (CallFrame *)framePtr; + ctx->framesSaved = 1; + } +} + + static void CallStackClearCmdReferences(Tcl_Interp *interp, Tcl_Command cmd) { XOTclCallStack *cs = &RUNTIME_STATE(interp)->cs; Index: generic/xotclStack85.c =================================================================== diff -u -rfa7bc22b99d66e75f67999d3b153d38f024c1be7 -rae922ee26ff2c658d5d0c3b8b98b71ab2f8bb4f9 --- generic/xotclStack85.c (.../xotclStack85.c) (revision fa7bc22b99d66e75f67999d3b153d38f024c1be7) +++ generic/xotclStack85.c (.../xotclStack85.c) (revision ae922ee26ff2c658d5d0c3b8b98b71ab2f8bb4f9) @@ -98,7 +98,7 @@ } XOTclCallStackContent * -XOTclCallStackFindActiveFrame(Tcl_Interp *interp, int offset) { +XOTclCallStackFindActiveFrame(Tcl_Interp *interp, int offset, Tcl_CallFrame **framePtrPtr) { register Tcl_CallFrame *varFramePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp); /* skip #offset frames */ @@ -110,14 +110,69 @@ XOTclCallStackContent *csc = (XOTclCallStackContent *)Tcl_CallFrame_clientData(varFramePtr); if (!(csc->frameType & XOTCL_CSC_TYPE_INACTIVE)) { /* we found the highest active frame */ + if (framePtrPtr) *framePtrPtr = varFramePtr; return csc; } } } /* we could not find an active frame; called from toplevel? */ + if (framePtrPtr) *framePtrPtr = NULL; return NULL; } +static void +CallStackUseActiveFrames(Tcl_Interp *interp, callFrameContext *ctx, int i) { + Tcl_CallFrame *inFramePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp), + *varFramePtr, *activeFramePtr, *framePtr; + + XOTclCallStackFindActiveFrame(interp, 0, &activeFramePtr); +# if defined(TCL85STACK_TRACE) + tcl85showStack(interp); +# endif + /* Get the first active non object frame (or object frame with proc */ + varFramePtr = nonXotclObjectProcFrame(inFramePtr); + + /*fprintf(stderr,"CallStackUseActiveFrames inframe %p varFrame %p activeFrame %p lvl %d\n", + inFramePtr,varFramePtr,activeFramePtr, Tcl_CallFrame_level(inFramePtr));*/ + + if (activeFramePtr == varFramePtr || activeFramePtr == inFramePtr) { + /* top frame is a active frame */ + framePtr = varFramePtr; + + } else if (activeFramePtr == NULL) { + /* There is no XOTcl callframe active; use the caller of inframe */ + /*fprintf(stderr,"activeFramePtr == NULL\n");*/ + + if ((Tcl_CallFrame_isProcCallFrame(inFramePtr) & FRAME_IS_XOTCL_METHOD) == 0) { + framePtr = varFramePtr; + } else { + framePtr = Tcl_CallFrame_callerPtr(inFramePtr); + } + + } else { + /* The active framePtr is an entry deeper in the stack. When XOTcl + is interleaved with Tcl, we return the Tcl frame */ + + /* fprintf(stderr,"active == deeper, use Tcl frame\n"); */ + for (framePtr = varFramePtr; framePtr && framePtr != activeFramePtr; + framePtr = Tcl_CallFrame_callerPtr(framePtr)) { + if ((Tcl_CallFrame_isProcCallFrame(framePtr) & (FRAME_IS_XOTCL_METHOD|FRAME_IS_XOTCL_CMETHOD)) == 0) { + break; + } + } + } + if (inFramePtr == framePtr) { + /* call frame pointers are fine */ + /*fprintf(stderr, "... no need to save frames\n");*/ + ctx->framesSaved = 0; + } else { + ctx->varFramePtr = inFramePtr; + Tcl_Interp_varFramePtr(interp) = (CallFrame *)framePtr; + ctx->framesSaved = 1; + } +} + + static void CallStackClearCmdReferences(Tcl_Interp *interp, Tcl_Command cmd) { register Tcl_CallFrame *varFramePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp); Index: tests/testx.xotcl =================================================================== diff -u -r26a70d9d268d8d827ec0ed631549fa6c5217d832 -rae922ee26ff2c658d5d0c3b8b98b71ab2f8bb4f9 --- tests/testx.xotcl (.../testx.xotcl) (revision 26a70d9d268d8d827ec0ed631549fa6c5217d832) +++ tests/testx.xotcl (.../testx.xotcl) (revision ae922ee26ff2c658d5d0c3b8b98b71ab2f8bb4f9) @@ -4199,14 +4199,15 @@ set c1 [llength [C info instances]] errorCheck [expr {$c1 - $c0 != 2}] 0 "exit x1, two more objects" } - x1 + errorCheck [expr {[llength [C info instances]] > 0}] 0 "top, volatile objects gone" Object o o proc test {} { x1; errorCheck [expr {[llength [C info instances]] > 0}] 0 "x1 from o" } + o test puts "PASSED ::topLevelCommands"