Index: generic/predefined.xotcl =================================================================== diff -u -r21544fe1eafcab9afcd83f516ab2759cd309f3ed -r26a70d9d268d8d827ec0ed631549fa6c5217d832 --- generic/predefined.xotcl (.../predefined.xotcl) (revision 21544fe1eafcab9afcd83f516ab2759cd309f3ed) +++ generic/predefined.xotcl (.../predefined.xotcl) (revision 26a70d9d268d8d827ec0ed631549fa6c5217d832) @@ -205,7 +205,7 @@ } } } - + # We provide a default value for superclass (when no superclass is specified explicitely) # for defining the top-level class of the object system, such that different # object systems might co-exist. Index: generic/xotcl.c =================================================================== diff -u -r13c614867b8e7cc4c7821f5027a309cfbd3b4d9e -r26a70d9d268d8d827ec0ed631549fa6c5217d832 --- generic/xotcl.c (.../xotcl.c) (revision 13c614867b8e7cc4c7821f5027a309cfbd3b4d9e) +++ generic/xotcl.c (.../xotcl.c) (revision 26a70d9d268d8d827ec0ed631549fa6c5217d832) @@ -443,11 +443,13 @@ Tcl uses 01 and 02, TclOO uses 04 and 08, so leave some space free for further extensions of tcl and tcloo... */ -# define FRAME_IS_XOTCL_METHOD 0x10000 -# define FRAME_IS_XOTCL_OBJECT 0x20000 +# define FRAME_IS_XOTCL_OBJECT 0x10000 +# define FRAME_IS_XOTCL_METHOD 0x20000 +# define FRAME_IS_XOTCL_CMETHOD 0x40000 #else -# define FRAME_IS_XOTCL_METHOD 0x0 -# define FRAME_IS_XOTCL_OBJECT 0x0 +# define FRAME_IS_XOTCL_OBJECT 0x0 +# define FRAME_IS_XOTCL_METHOD 0x0 +# define FRAME_IS_XOTCL_CMETHOD 0x0 #endif #if defined(PRE85) @@ -645,9 +647,10 @@ }*/ framePtr = (Tcl_CallFrame *)Tcl_Interp_framePtr(interp); for (; framePtr; framePtr = Tcl_CallFrame_callerPtr(framePtr)) { - fprintf(stderr, "... var frame %p flags %.6x cd %p ns %p %s objv[0] %s\n", + fprintf(stderr, "... var frame %p flags %.6x cd %p lvl %d ns %p %s objv[0] %s\n", framePtr, Tcl_CallFrame_isProcCallFrame(framePtr), Tcl_CallFrame_clientData(framePtr), + Tcl_CallFrame_level(framePtr), Tcl_CallFrame_nsPtr(framePtr), Tcl_CallFrame_nsPtr(framePtr)->fullName, Tcl_CallFrame_objc(framePtr) ? ObjStr(Tcl_CallFrame_objv(framePtr)[0]) : "(null)"); } @@ -656,7 +659,7 @@ 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) == 0) break; + if ((Tcl_CallFrame_isProcCallFrame(framePtr) & (FRAME_IS_XOTCL_OBJECT|FRAME_IS_XOTCL_CMETHOD)) == 0) break; } return framePtr; } @@ -2384,37 +2387,6 @@ * XOTcl CallStack */ -XOTclCallStackContent * -XOTclCallStackFindLastInvocation(Tcl_Interp *interp, int offset) { - XOTclCallStack *cs = &RUNTIME_STATE(interp)->cs; - register XOTclCallStackContent *csc = cs->top; - int topLevel = csc->currentFramePtr ? Tcl_CallFrame_level(csc->currentFramePtr) : 0; - int deeper = offset; - - /* skip through toplevel inactive filters, do this offset times */ - for (csc=cs->top; csc > cs->content; csc--) { - /* fprintf(stderr, "csc %p callType = %x, frameType = %x, offset=%d\n", - csc,csc->callType,csc->frameType,offset); */ - if ((csc->callType & XOTCL_CSC_CALL_IS_NEXT) || - (csc->frameType & XOTCL_CSC_TYPE_INACTIVE)) - continue; - if (offset) - offset--; - else { - /* fprintf(stderr, "csc %p offset ok, deeper=%d\n",csc,deeper); */ - if (!deeper || cs->top->callType & XOTCL_CSC_CALL_IS_GUARD) { - return csc; - } - if (csc->currentFramePtr && Tcl_CallFrame_level(csc->currentFramePtr) < topLevel) { - return csc; - } - } - } - /* for some reasons, we could not find invocation (topLevel, destroy) */ - /* fprintf(stderr, "csc %p could not find invocation\n",csc);*/ - return NULL; -} - static XOTclCallStackContent * CallStackFindActiveFilter(Tcl_Interp *interp) { XOTclCallStack *cs = &RUNTIME_STATE(interp)->cs; @@ -5389,7 +5361,8 @@ * TODO: maybe push should happend alread before assertion checking, * but we have to check what happens in the finish target etc. */ - XOTcl_PushFrame(interp, obj); + XOTcl_PushFrameCsc(interp, obj, csc); + /*XOTcl_PushFrame(interp, obj);*/ } #endif @@ -6973,24 +6946,6 @@ csc = CallStackGetTopFrame(interp); } -#if !defined(NDEBUG) - if (useCallstackObjs) { - Tcl_CallFrame *cf = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp); - int found = 0; - while (cf) { - /* fprintf(stderr, " ... compare fp = %p and cfp %p procFrame %p oc=%d\n", - cf, csc->currentFramePtr, - Tcl_Interp_framePtr(interp), Tcl_CallFrame_objc(Tcl_Interp_framePtr(interp)) - );*/ - if (cf == csc->currentFramePtr) { - found = 1; - break; - } - cf = (Tcl_CallFrame *)((CallFrame *)cf)->callerPtr; - } - } -#endif - /*fprintf(stderr,"XOTclNextMethod givenMethod = %s, csc = %p, useCallstackObj %d, objc %d cfp %p\n", givenMethod, csc, useCallstackObjs, objc, csc->currentFramePtr);*/ @@ -9074,13 +9029,28 @@ int objc, Tcl_Obj *CONST objv[]) { forwardCmdClientData *tcd = (forwardCmdClientData *)clientData; int result, j, inputarg = 1, outputarg = 0; +#if TCL85STACK + XOTclCallStackContent *csc = NULL; + Tcl_CallFrame *varFramePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp); + /*fprintf(stderr, "XOTclForwardMethod varFramePtr %p flags %.6x\n", + varFramePtr, Tcl_CallFrame_isProcCallFrame(varFramePtr));*/ + if (Tcl_CallFrame_isProcCallFrame(varFramePtr) & (FRAME_IS_XOTCL_METHOD|FRAME_IS_XOTCL_CMETHOD)) { + csc = (XOTclCallStackContent *)Tcl_CallFrame_clientData(varFramePtr); + } + if (csc == NULL) { + tcl85showStack(interp); + fprintf(stderr, "??? would set in csc %p to %p\n",RUNTIME_STATE(interp)->cs.top,Tcl_Interp_varFramePtr(interp)); + csc = RUNTIME_STATE(interp)->cs.top; + } + /* no need to store varFramePtr in call frame for tcl85stack */ +#else + XOTclCallStackContent *csc = CallStackGetTopFrame(interp); + csc->currentFramePtr = (Tcl_CallFrame *) Tcl_Interp_varFramePtr(interp); +#endif + if (!tcd || !tcd->obj) return XOTclObjErrType(interp, objv[0], "Object"); - /* it is a c-method; establish a value for the currentFramePtr */ - RUNTIME_STATE(interp)->cs.top->currentFramePtr = - (Tcl_CallFrame *) Tcl_Interp_varFramePtr(interp); - /*fprintf(stderr,"...setting currentFramePtr %p to %p (ForwardMethod)\n", RUNTIME_STATE(interp)->cs.top->currentFramePtr, (Tcl_CallFrame *) Tcl_Interp_varFramePtr(interp)); */ Index: generic/xotcl.h =================================================================== diff -u -r13c614867b8e7cc4c7821f5027a309cfbd3b4d9e -r26a70d9d268d8d827ec0ed631549fa6c5217d832 --- generic/xotcl.h (.../xotcl.h) (revision 13c614867b8e7cc4c7821f5027a309cfbd3b4d9e) +++ generic/xotcl.h (.../xotcl.h) (revision 26a70d9d268d8d827ec0ed631549fa6c5217d832) @@ -85,6 +85,7 @@ /* #define TCL85STACK_TRACE 1 #define TCL85STACK 1 +#define CANONICAL_ARGS 1 */ #define CANONICAL_ARGS 1 #define TCL85STACK 1 Index: generic/xotclInt.h =================================================================== diff -u -r8ddbf5cdc1dd1f9e0d9c429a8c3f6d279c97bd8e -r26a70d9d268d8d827ec0ed631549fa6c5217d832 --- generic/xotclInt.h (.../xotclInt.h) (revision 8ddbf5cdc1dd1f9e0d9c429a8c3f6d279c97bd8e) +++ generic/xotclInt.h (.../xotclInt.h) (revision 26a70d9d268d8d827ec0ed631549fa6c5217d832) @@ -266,9 +266,9 @@ */ #define XOTcl_FrameDecls TclCallFrame frame, *framePtr = &frame; int frame_constructed = 1 # ifndef PRE85 -# define XOTcl_PushFrameCd(obj) ((CallFrame *)framePtr)->clientData = (ClientData)obj +# define XOTcl_PushFrameSetCd(obj) ((CallFrame *)framePtr)->clientData = (ClientData)obj # else -# define XOTcl_PushFrameCd(obj) +# define XOTcl_PushFrameSetCd(obj) # endif #define XOTcl_PushFrame(interp,obj) \ /*fprintf(stderr,"PUSH OBJECT_FRAME (XOTcl_PushFrame) frame %p\n",framePtr); */ \ @@ -283,7 +283,21 @@ Tcl_CallFrame_procPtr(myframePtr) = &RUNTIME_STATE(interp)->fakeProc; \ Tcl_CallFrame_varTablePtr(myframePtr) = (obj)->varTable; \ } \ - XOTcl_PushFrameCd(obj) + XOTcl_PushFrameSetCd(obj) +#define XOTcl_PushFrameCsc(interp,obj,csc) \ + /*fprintf(stderr,"PUSH OBJECT_FRAME (XOTcl_PushFrame) frame %p\n",framePtr); */ \ + if ((obj)->nsPtr) { \ + frame_constructed = 0; \ + /*fprintf(stderr,"XOTcl_PushFrame frame %p\n",framePtr);*/ \ + Tcl_PushCallFrame(interp, (Tcl_CallFrame*)framePtr, (obj)->nsPtr, 0|FRAME_IS_XOTCL_CMETHOD); \ + } else { \ + CallFrame *myframePtr = (CallFrame *)framePtr; \ + /*fprintf(stderr,"XOTcl_PushFrame frame %p (with fakeNS)\n",framePtr);*/ \ + Tcl_PushCallFrame(interp, (Tcl_CallFrame*)framePtr, /* RUNTIME_STATE(interp)->fakeNS */ Tcl_CallFrame_nsPtr(Tcl_Interp_varFramePtr(interp)), 1|FRAME_IS_XOTCL_CMETHOD); \ + Tcl_CallFrame_procPtr(myframePtr) = &RUNTIME_STATE(interp)->fakeProc; \ + Tcl_CallFrame_varTablePtr(myframePtr) = (obj)->varTable; \ + } \ + XOTcl_PushFrameSetCd(csc) #define XOTcl_PopFrame(interp,obj) \ if (!(obj)->nsPtr) { \ CallFrame *myframe = (CallFrame *)framePtr; \ @@ -759,8 +773,6 @@ XOTclCallStackContent * XOTclCallStackFindActiveFrame(Tcl_Interp *interp, int offset); -XOTclCallStackContent * -XOTclCallStackFindLastInvocation(Tcl_Interp *interp, int offset); /* functions from xotclUtil.c */ char *XOTcl_ltoa(char *buf, long i, int *len); Index: generic/xotclStack.c =================================================================== diff -u -red8301802df5fc7427fc0e4dbd82c2cf880329de -r26a70d9d268d8d827ec0ed631549fa6c5217d832 --- generic/xotclStack.c (.../xotclStack.c) (revision ed8301802df5fc7427fc0e4dbd82c2cf880329de) +++ generic/xotclStack.c (.../xotclStack.c) (revision 26a70d9d268d8d827ec0ed631549fa6c5217d832) @@ -34,6 +34,37 @@ return cs->top; } +XOTclCallStackContent * +XOTclCallStackFindLastInvocation(Tcl_Interp *interp, int offset) { + XOTclCallStack *cs = &RUNTIME_STATE(interp)->cs; + register XOTclCallStackContent *csc = cs->top; + int topLevel = csc->currentFramePtr ? Tcl_CallFrame_level(csc->currentFramePtr) : 0; + int deeper = offset; + + /* skip through toplevel inactive filters, do this offset times */ + for (csc=cs->top; csc > cs->content; csc--) { + /* fprintf(stderr, "csc %p callType = %x, frameType = %x, offset=%d\n", + csc,csc->callType,csc->frameType,offset); */ + if ((csc->callType & XOTCL_CSC_CALL_IS_NEXT) || + (csc->frameType & XOTCL_CSC_TYPE_INACTIVE)) + continue; + if (offset) + offset--; + else { + /* fprintf(stderr, "csc %p offset ok, deeper=%d\n",csc,deeper); */ + if (!deeper || cs->top->callType & XOTCL_CSC_CALL_IS_GUARD) { + return csc; + } + if (csc->currentFramePtr && Tcl_CallFrame_level(csc->currentFramePtr) < topLevel) { + return csc; + } + } + } + /* for some reasons, we could not find invocation (topLevel, destroy) */ + /* fprintf(stderr, "csc %p could not find invocation\n",csc);*/ + return NULL; +} + static void CallStackClearCmdReferences(Tcl_Interp *interp, Tcl_Command cmd) { XOTclCallStack *cs = &RUNTIME_STATE(interp)->cs; Index: generic/xotclStack85.c =================================================================== diff -u -red8301802df5fc7427fc0e4dbd82c2cf880329de -r26a70d9d268d8d827ec0ed631549fa6c5217d832 --- generic/xotclStack85.c (.../xotclStack85.c) (revision ed8301802df5fc7427fc0e4dbd82c2cf880329de) +++ generic/xotclStack85.c (.../xotclStack85.c) (revision 26a70d9d268d8d827ec0ed631549fa6c5217d832) @@ -20,7 +20,7 @@ #endif return (XOTclObject *)Tcl_CallFrame_clientData(varFramePtr); } - if (Tcl_CallFrame_isProcCallFrame(varFramePtr) & FRAME_IS_XOTCL_METHOD) { + if (Tcl_CallFrame_isProcCallFrame(varFramePtr) & (FRAME_IS_XOTCL_METHOD|FRAME_IS_XOTCL_CMETHOD)) { XOTclCallStackContent *csc = (XOTclCallStackContent *)Tcl_CallFrame_clientData(varFramePtr); #if defined(TCL85STACK_TRACE) fprintf(stderr, "... self returns %s\n",objectName(csc->self)); @@ -43,7 +43,7 @@ Tcl_CallFrame_clientData(varFramePtr), Tcl_CallFrame_objc(varFramePtr) ? ObjStr(Tcl_CallFrame_objv(varFramePtr)[0]) : "(null)"); # endif - if (Tcl_CallFrame_isProcCallFrame(varFramePtr) & FRAME_IS_XOTCL_METHOD) { + if (Tcl_CallFrame_isProcCallFrame(varFramePtr) & (FRAME_IS_XOTCL_METHOD|FRAME_IS_XOTCL_CMETHOD)) { return (XOTclCallStackContent *)Tcl_CallFrame_clientData(varFramePtr); } } @@ -74,12 +74,35 @@ } #endif +XOTclCallStackContent * +XOTclCallStackFindLastInvocation(Tcl_Interp *interp, int offset) { + register Tcl_CallFrame *varFramePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp); + int topLevel = Tcl_CallFrame_level(varFramePtr); + + for (; varFramePtr; varFramePtr = Tcl_CallFrame_callerPtr(varFramePtr)) { + if (Tcl_CallFrame_isProcCallFrame(varFramePtr) & (FRAME_IS_XOTCL_METHOD|FRAME_IS_XOTCL_CMETHOD)) { + XOTclCallStackContent *csc = (XOTclCallStackContent *)Tcl_CallFrame_clientData(varFramePtr); + if ((csc->callType & XOTCL_CSC_CALL_IS_NEXT) || (csc->frameType & XOTCL_CSC_TYPE_INACTIVE)) { + continue; + } + if (offset) + offset--; + else { + if (Tcl_CallFrame_level(varFramePtr) < topLevel) { + return csc; + } + } + } + } + return NULL; +} + static void CallStackClearCmdReferences(Tcl_Interp *interp, Tcl_Command cmd) { register Tcl_CallFrame *varFramePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp); for (; varFramePtr; varFramePtr = Tcl_CallFrame_callerPtr(varFramePtr)) { - if (Tcl_CallFrame_isProcCallFrame(varFramePtr) & FRAME_IS_XOTCL_METHOD) { + if (Tcl_CallFrame_isProcCallFrame(varFramePtr) & (FRAME_IS_XOTCL_METHOD|FRAME_IS_XOTCL_CMETHOD)) { XOTclCallStackContent *csc = (XOTclCallStackContent *)Tcl_CallFrame_clientData(varFramePtr); if (csc->cmdPtr == cmd) { csc->cmdPtr = NULL; @@ -93,7 +116,7 @@ register Tcl_CallFrame *varFramePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp); for (; varFramePtr; varFramePtr = Tcl_CallFrame_callerPtr(varFramePtr)) { - if (Tcl_CallFrame_isProcCallFrame(varFramePtr) & FRAME_IS_XOTCL_METHOD) { + if (Tcl_CallFrame_isProcCallFrame(varFramePtr) & (FRAME_IS_XOTCL_METHOD|FRAME_IS_XOTCL_CMETHOD)) { XOTclCallStackContent *csc = (XOTclCallStackContent *)Tcl_CallFrame_clientData(varFramePtr); if (csc->self == obj) { return csc; @@ -146,7 +169,7 @@ Tcl_Command oid = obj->id; for (; varFramePtr; varFramePtr = Tcl_CallFrame_callerPtr(varFramePtr)) { - if (Tcl_CallFrame_isProcCallFrame(varFramePtr) & FRAME_IS_XOTCL_METHOD) { + if (Tcl_CallFrame_isProcCallFrame(varFramePtr) & (FRAME_IS_XOTCL_METHOD|FRAME_IS_XOTCL_CMETHOD)) { XOTclCallStackContent *csc = (XOTclCallStackContent *)Tcl_CallFrame_clientData(varFramePtr); if (csc->self == obj) { csc->destroyedCmd = oid; Index: tests/testx.xotcl =================================================================== diff -u -r13c614867b8e7cc4c7821f5027a309cfbd3b4d9e -r26a70d9d268d8d827ec0ed631549fa6c5217d832 --- tests/testx.xotcl (.../testx.xotcl) (revision 13c614867b8e7cc4c7821f5027a309cfbd3b4d9e) +++ tests/testx.xotcl (.../testx.xotcl) (revision 26a70d9d268d8d827ec0ed631549fa6c5217d832) @@ -3724,8 +3724,8 @@ errorCheck [t loop1] 3 "uplevel eval loop" errorCheck [t loop2] 12 "nested uplevel eval loop" t filter f - errorCheck [t loop1] 3 "uplevel eval loop" - errorCheck [t loop2] 12 "nested uplevel eval loop" + errorCheck [t loop1] 3 "uplevel eval loop with filter" + errorCheck [t loop2] 12 "nested uplevel eval loop with filter" t destroy }