Index: TODO =================================================================== diff -u -r3dc0790960d69f641ccc7d52ead8bcf6c4db1830 -r2fa3f1c596fedf924397e424b532d7f223c8b621 --- TODO (.../TODO) (revision 3dc0790960d69f641ccc7d52ead8bcf6c4db1830) +++ TODO (.../TODO) (revision 2fa3f1c596fedf924397e424b532d7f223c8b621) @@ -1476,6 +1476,11 @@ - some refactoring for making code structure more sane for NRE (but not done yet) +- save snapshot; refactoring in order to ease NRE + development with unified method and dipatch exit. +- named debugging cmds __db_* +- new cmd __db_run_assertions to perform checking of the internal state + TODO: - check my for NRE-enabling - major coro cleanup, when working Index: generic/gentclAPI.decls =================================================================== diff -u -r79c263a13be8850014d056153956f5a83dfbb639 -r2fa3f1c596fedf924397e424b532d7f223c8b621 --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision 79c263a13be8850014d056153956f5a83dfbb639) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision 2fa3f1c596fedf924397e424b532d7f223c8b621) @@ -17,8 +17,10 @@ # # Next Scripting commands # -nsfCmd yieldcheck NsfYiedCheckCmd { +nsfCmd __db__yield NsfDebugYiedCmd { } +nsfCmd __db_run_assertions NsfDebugRunAssertionsCmd { +} nsfCmd alias NsfAliasCmd { {-argName "object" -type object} {-argName "-per-object"} Index: generic/nsf.c =================================================================== diff -u -r3dc0790960d69f641ccc7d52ead8bcf6c4db1830 -r2fa3f1c596fedf924397e424b532d7f223c8b621 --- generic/nsf.c (.../nsf.c) (revision 3dc0790960d69f641ccc7d52ead8bcf6c4db1830) +++ generic/nsf.c (.../nsf.c) (revision 2fa3f1c596fedf924397e424b532d7f223c8b621) @@ -185,8 +185,10 @@ NSF_INLINE static int ObjectDispatch(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags); //TODO remove string, methodName -NSF_INLINE static void ObjectDispatchFinalize(NsfObject *object, int flags, - char *string, CONST char *methodName); +NSF_INLINE static int ObjectDispatchFinalize(Tcl_Interp *interp, NsfCallStackContent *cscPtr, + NsfObject *object, + int flags, int result, + char *string, CONST char *methodName); /* prototypes for object life-cycle management */ static int DoDealloc(Tcl_Interp *interp, NsfObject *object); @@ -225,7 +227,7 @@ /* prototypes for call stack specific calls */ NSF_INLINE static void CscInit(NsfCallStackContent *cscPtr, NsfObject *object, NsfClass *cl, - Tcl_Command cmd, int frameType); + Tcl_Command cmd, int frameType, char *msg); NSF_INLINE static void CscFinish(Tcl_Interp *interp, NsfCallStackContent *cscPtr, char *string); static NsfCallStackContent *CallStackGetFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr); NSF_INLINE static void CallStackDoDestroy(Tcl_Interp *interp, NsfObject *object); @@ -5917,7 +5919,7 @@ NsfTclStackFree(interp, pcPtr, "release parse context"); } #if defined(NRE) - ObjectDispatchFinalize(object, cscPtr->callType, "NRE", methodName); + result = ObjectDispatchFinalize(interp, cscPtr, object, cscPtr->callType, result, "NRE", methodName); #endif CscFinish(interp, cscPtr, "scripted finalize"); @@ -6097,7 +6099,7 @@ assert(object); assert(object->teardown); #if defined(NRE) - assert(!cscPtr || cscPtr->callType == 0); + assert(!cscPtr || (cscPtr->callType & NSF_CSC_CALL_IS_NRE) == 0); #endif #if defined(TCL85STACK_TRACE) @@ -6587,13 +6589,13 @@ //fprintf(stderr, "MethodDispatch method '%s.%s' objc %d flags %.6x call %d\n", // objectName(object),methodName, objc, flags, call); - cscPtr = CscAlloc(interp, &csc, Tcl_Command_objProc(cmd)); + cscPtr = CscAlloc(interp, &csc, cmd); /* * We would not need CscInit when * cp == NULL && !(Tcl_Command_flags(cmd) & NSF_CMD_NONLEAF_METHOD) */ - CscInit(cscPtr, object, cl, cmd, frameType); + CscInit(cscPtr, object, cl, cmd, frameType, "method dispatch"); result = MethodDispatchCsc(clientData, interp, objc, objv, cscPtr, methodName, flags); @@ -6603,34 +6605,42 @@ return result; } -NSF_INLINE static void -ObjectDispatchFinalize(NsfObject *object, int flags, char *string, CONST char *methodName) { +// TODO: not all args needed +NSF_INLINE static int +ObjectDispatchFinalize(Tcl_Interp *interp, NsfCallStackContent *cscPtr, + NsfObject *object, int flags, int result, + char *string, CONST char *methodName) { - if (!object->id) { - fprintf(stderr, "ObjectDispatchFinalize %p flags %.6x id %p %s\n", - object, object->flags, object->id, string); - return; - } - //fprintf(stderr, "ObjectDispatchFinalize %s.%s flags %.6x %s\n", objectName(object), methodName, flags, string); + assert(object->id); + /*fprintf(stderr, "ObjectDispatchFinalize %s.%s flags %.6x %s\n", + objectName(object), methodName, flags, string);*/ + #ifdef DISPATCH_TRACE PrintExit(interp, "DISPATCH", objc, objv, result); #endif - /*fprintf(stderr, "mixinStackPushed %d frametype %d eq %d\n",mixinStackPushed, - flags & NSF_CSC_MIXIN_STACK_PUSHED, - mixinStackPushed == ((flags & NSF_CSC_MIXIN_STACK_PUSHED) != 0));*/ + if (flags & NSF_CSC_UNKNOWN) { + /* be sure to reset unknown flag */ + if ((flags & NSF_CSC_ACTIVE_FILTER) == 0) { + /*fprintf(stderr, "ObjectDispatch **** rst->unknown set to 0 flags %.6x frameType %.6x\n", + flags,frameType);*/ + RUNTIME_STATE(interp)->unknown = 0; + } + } if ((flags & NSF_CSC_MIXIN_STACK_PUSHED) && object->mixinStack) { - //fprintf(stderr, "MixinStackPop %s.%s %p %s\n", - // objectName(object),methodName, object->mixinStack, string); + /*fprintf(stderr, "MixinStackPop %s.%s %p %s\n", + objectName(object),methodName, object->mixinStack, string);*/ MixinStackPop(object); } if ((flags & NSF_CSC_FILTER_STACK_PUSHED) && object->filterStack) { - //fprintf(stderr, "FilterStackPop %s.%s %p %s\n", - // objectName(object),methodName, object->filterStack, string); + /* fprintf(stderr, "FilterStackPop %s.%s %p %s\n", + objectName(object),methodName, object->filterStack, string);*/ FilterStackPop(object); } + + return result; } NSF_INLINE static int @@ -6661,6 +6671,9 @@ methodObj = objv[1]; } + /* non of the higher copy-flags must be passed */ + assert((flags & (NSF_CSC_COPY_FLAGS & 0x1100)) == 0); + methodName = ObjStr(methodObj); if (FOR_COLON_RESOLVER(methodName)) { methodName ++; @@ -6730,6 +6743,11 @@ if (cmd) { /*fprintf(stderr, "filterSearchProc returned cmd %p\n", cmd);*/ frameType = NSF_CSC_TYPE_ACTIVE_FILTER; + /* + * The following line might look redundant, be we can control + * this way the unknown handling via flags. + */ + flags |= NSF_CSC_ACTIVE_FILTER; methodName = (char *)Tcl_GetCommandName(interp, cmd); } else { /*fprintf(stderr, "filterSearchProc returned no cmd\n");*/ @@ -6763,7 +6781,8 @@ // objectName(object), methodName, result, cmd, object->mixinStack->currentCmdPtr); if (result != TCL_OK) { - goto exit_dispatch; + fprintf(stderr, "mixinsearch failed for %p %s.%s\n", object, objectName(object),methodName); + goto exit_object_dispatch; } if (cmd) { frameType = NSF_CSC_TYPE_ACTIVE_MIXIN; @@ -6838,12 +6857,13 @@ } } + cscPtr = CscAlloc(interp, &csc, cmd); + CscInit(cscPtr, object, cl, cmd, frameType, "object dispatch"); + if (!unknown) { - cscPtr = CscAlloc(interp, &csc, Tcl_Command_objProc(cmd)); - CscInit(cscPtr, object, cl, cmd, frameType); // TODO testing, just for the time being - if ((frameType & NSF_CSC_TYPE_ACTIVE_FILTER)) { + if ((flags & NSF_CSC_ACTIVE_FILTER)) { // run filters not NRE enabled flags |= NSF_CSC_IMMEDIATE; // testing with NRE-enabled filters, to invoke UNKNOWN from ProcMethodDispatchFinalize() @@ -6855,13 +6875,8 @@ cscPtr, methodName, flags); #if defined(NRE) - if ((cscPtr->callType & NSF_CSC_CALL_IS_NRE) == 0) { - CscCleanup(interp, cscPtr); - } else { - isNRE = 1; - } -#else - CscCleanup(interp, cscPtr); + // todo var isNRE is not needed + isNRE = (cscPtr->callType & NSF_CSC_CALL_IS_NRE); #endif if (result == TCL_ERROR) { @@ -6872,7 +6887,7 @@ methodName); } - if (rst->unknown && (frameType & NSF_CSC_TYPE_ACTIVE_FILTER)) { + if (rst->unknown && (flags & NSF_CSC_ACTIVE_FILTER)) { /*fprintf(stderr, "ObjectDispatch use saved unknown %d frameType %.6x\n", RUNTIME_STATE(interp)->unknown, frameType);*/ unknown = 1; @@ -6882,8 +6897,15 @@ } } else { + cscPtr = CscAlloc(interp, &csc, cmd); + CscInit(cscPtr, object, cl, cmd, frameType, "unkown"); + unknown = 1; } + + if (unknown) { + flags |= NSF_CSC_UNKNOWN; + } /*fprintf(stderr, "ObjectDispatch %s.%s isNRE %d cmd %p unknown %d result %d\n", objectName(object), methodName, isNRE, cmd, unknown, result);*/ @@ -6893,38 +6915,31 @@ if (unknown) { // just pass IMMEDIATE flag ; TODO: maybe pass it always? - /*fprintf(stderr, "ObjectDispatch calling unknown flags %.6x\n", flags);*/ + /*fprintf(stderr, "ObjectDispatch calling unknown, flags %.6x\n", flags);*/ result = DispatchUnknownMethod(clientData, interp, - objc-shift, objv+shift, methodObj, flags&NSF_CSC_IMMEDIATE); + objc-shift, objv+shift, methodObj, + NSF_CSC_IMMEDIATE + /*flags&NSF_CSC_IMMEDIATE*/); /*fprintf(stderr, "ObjectDispatch UNKNOWN returns %d\n", result);*/ } } - /* be sure to reset unknown flag */ - if (unknown && (frameType & NSF_CSC_TYPE_ACTIVE_FILTER) == 0) { - /*fprintf(stderr, "ObjectDispatch **** rst->unknown set to 0 flags %.6x frameType %.6x\n", - flags,frameType);*/ - rst->unknown = 0; - } - exit_dispatch: - /* - if (cscPtr) { + exit_object_dispatch: + /* + * In most situations, we have a cscPtr. however, it is not set, + * when e.g. a mixin guard has failed + */ #if defined(NRE) - if ((cscPtr->callType & NSF_CSC_CALL_IS_NRE) == 0) { - CscCleanup(interp, cscPtr); - } -#endif - CscCleanup(interp, cscPtr); - }*/ -#if defined(NRE) if (!isNRE) { - ObjectDispatchFinalize(object, flags, "immediate", methodName); + result = ObjectDispatchFinalize(interp, cscPtr, object, flags, result, "immediate", methodName); + if (cscPtr) CscFinish(interp, cscPtr, "non-scripted finalize"); } #else - ObjectDispatchFinalize(object, flags, "immediate", methodName); + result = ObjectDispatchFinalize(interp, cscPtr, object, flags, result, "immediate", methodName); + if (cscPtr) CscFinish(interp, cscPtr, "non-scripted finalize"); #endif - + /*fprintf(stderr, "ObjectDispatch %s.%s returns %d\n", objectName(object), methodName, result);*/ @@ -11760,11 +11775,11 @@ * Begin generated Next Scripting commands *******************************************/ /* -nsfCmd yieldcheck NsfYiedCheckCmd { +nsfCmd __db__yield NsfDebugYiedCmd { } */ static int -NsfYiedCheckCmd(Tcl_Interp *interp) { +NsfDebugYiedCmd(Tcl_Interp *interp) { #if defined(NRE) //Interp *iPtr = (Interp *)interp; //CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; @@ -11776,6 +11791,62 @@ } /* +nsfCmd __db_run_assertions NsfDebugRunAssertionsCmd { +} +*/ +static int +NsfDebugRunAssertionsCmd(Tcl_Interp *interp) { + Tcl_HashTable table, *tablePtr = &table; + NsfObjectSystem *osPtr; + Tcl_HashSearch hSrch; + Tcl_HashEntry *hPtr; + + /* collect all instances from all object systems */ + Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS); + for (osPtr = RUNTIME_STATE(interp)->objectSystems; osPtr; osPtr = osPtr->nextPtr) { + GetAllInstances(interp, tablePtr, osPtr->rootClass); + } + + for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSrch); hPtr; hPtr = Tcl_NextHashEntry(&hSrch)) { + char *key = Tcl_GetHashKey(tablePtr, hPtr); + NsfObject *object = GetObjectFromString(interp, key); + + assert(object); + + if (object->activationCount > 0) { + Tcl_CallFrame *framePtr; + int count = 0; + /*fprintf(stderr, "DEBUG obj %p %s activationcount %d\n", + object, objectName(object), object->activationCount);*/ + + framePtr = (Tcl_CallFrame *)Tcl_Interp_framePtr(interp); + for (; framePtr; framePtr = Tcl_CallFrame_callerPtr(framePtr)) { + int frameFlags = Tcl_CallFrame_isProcCallFrame(framePtr); + NsfCallStackContent *cscPtr = + (frameFlags & (FRAME_IS_NSF_METHOD|FRAME_IS_NSF_CMETHOD)) ? + ((NsfCallStackContent *)Tcl_CallFrame_clientData(framePtr)) : NULL; + if (cscPtr && cscPtr->self == object) count ++; + if (cscPtr && (NsfObject*)cscPtr->cl == object) count ++; + } + if (count != object->activationCount) { + fprintf(stderr, "DEBUG obj %p %s activationcount %d on stack %d \n", + object, objectName(object), object->activationCount, count); + //return NsfVarErrMsg(interp, "wrong activation count for object ", + // objectName(object), (char *) NULL); + } + } else { + if (object->activationCount != 0) { + fprintf(stderr, "DEBUG obj %p %s activationcount %d\n", + object, objectName(object), object->activationCount); + } + assert(object->activationCount == 0); + } + } + fprintf(stderr, "all assertions passed\n"); + return TCL_OK; +} + +/* nsfCmd alias NsfAliasCmd { {-argName "object" -type object} {-argName "-per-object"} @@ -13884,7 +13955,7 @@ */ Tcl_Interp_varFramePtr(interp) = varFramePtr->callerPtr; - CscInit(cscPtr, object, NULL /*cl*/, NULL/*cmd*/, NSF_CSC_TYPE_PLAIN); + CscInit(cscPtr, object, NULL /*cl*/, NULL/*cmd*/, NSF_CSC_TYPE_PLAIN, "initcmd"); Nsf_PushFrameCsc(interp, cscPtr, framePtr2); if (paramPtr->flags & NSF_ARG_INITCMD) { @@ -15746,8 +15817,10 @@ object->refCount = 1; } + if (object->activationCount != 0) + fprintf(stderr, "FinalObjectDeletion obj %p activationcount %d\n", object, object->activationCount); assert(object->activationCount == 0); - /*fprintf(stderr, "FinalObjectDeletion obj %p activationcount %d\n", object, object->activationCount);*/ + if (object->id) { /*fprintf(stderr, "cmd dealloc %p final delete refCount %d\n", object->id, Tcl_Command_refCount(object->id));*/ Tcl_DeleteCommandFromToken(interp, object->id); Index: generic/nsf.h =================================================================== diff -u -r3dc0790960d69f641ccc7d52ead8bcf6c4db1830 -r2fa3f1c596fedf924397e424b532d7f223c8b621 --- generic/nsf.h (.../nsf.h) (revision 3dc0790960d69f641ccc7d52ead8bcf6c4db1830) +++ generic/nsf.h (.../nsf.h) (revision 2fa3f1c596fedf924397e424b532d7f223c8b621) @@ -84,6 +84,7 @@ */ //#define TCL_STACK_ALLOC_TRACE 1 +//#define NRE_CALLBACK_TRACE 1 /* turn tracing output on/off #define NSFOBJ_TRACE 1 Index: generic/nsfInt.h =================================================================== diff -u -r3dc0790960d69f641ccc7d52ead8bcf6c4db1830 -r2fa3f1c596fedf924397e424b532d7f223c8b621 --- generic/nsfInt.h (.../nsfInt.h) (revision 3dc0790960d69f641ccc7d52ead8bcf6c4db1830) +++ generic/nsfInt.h (.../nsfInt.h) (revision 2fa3f1c596fedf924397e424b532d7f223c8b621) @@ -615,24 +615,26 @@ unsigned short callType; } NsfCallStackContent; -#define NSF_CSC_TYPE_PLAIN 0 -#define NSF_CSC_TYPE_ACTIVE_MIXIN 1 -#define NSF_CSC_TYPE_ACTIVE_FILTER 2 -#define NSF_CSC_TYPE_INACTIVE 4 -#define NSF_CSC_TYPE_INACTIVE_MIXIN 5 -#define NSF_CSC_TYPE_INACTIVE_FILTER 6 -#define NSF_CSC_TYPE_GUARD 0x10 -#define NSF_CSC_TYPE_ENSEMBLE 0x20 +#define NSF_CSC_TYPE_PLAIN 0 +#define NSF_CSC_TYPE_ACTIVE_MIXIN 1 +#define NSF_CSC_TYPE_ACTIVE_FILTER 2 +#define NSF_CSC_TYPE_INACTIVE 4 +#define NSF_CSC_TYPE_INACTIVE_MIXIN 5 +#define NSF_CSC_TYPE_INACTIVE_FILTER 6 +#define NSF_CSC_TYPE_GUARD 0x10 +#define NSF_CSC_TYPE_ENSEMBLE 0x20 -#define NSF_CSC_CALL_IS_NEXT 1 -#define NSF_CSC_CALL_IS_GUARD 2 -#define NSF_CSC_CALL_IS_ENSEMBLE 4 /*TODO: needed?*/ -#define NSF_CSC_IMMEDIATE 0x020 -#define NSF_CSC_CALL_IS_NRE 0x100 -#define NSF_CSC_MIXIN_STACK_PUSHED 0x200 -#define NSF_CSC_FILTER_STACK_PUSHED 0x400 -#define NSF_CSC_UNKNOWN 0x800 -#define NSF_CSC_COPY_FLAGS (NSF_CSC_MIXIN_STACK_PUSHED|NSF_CSC_FILTER_STACK_PUSHED|NSF_CSC_IMMEDIATE|NSF_CSC_UNKNOWN) +#define NSF_CSC_CALL_IS_NEXT 1 +#define NSF_CSC_CALL_IS_GUARD 2 +#define NSF_CSC_CALL_IS_ENSEMBLE 4 /*TODO: needed?*/ +#define NSF_CSC_IMMEDIATE 0x0020 +#define NSF_CSC_CALL_IS_NRE 0x0100 +#define NSF_CSC_MIXIN_STACK_PUSHED 0x0200 +#define NSF_CSC_FILTER_STACK_PUSHED 0x0400 +#define NSF_CSC_UNKNOWN 0x0800 /* TODO needed in copy flags ? */ +#define NSF_CSC_ACTIVE_FILTER 0x1000 // should not be longer needed +#define NSF_CSC_OBJECT_ACTIVATED 0x2000 +#define NSF_CSC_COPY_FLAGS (NSF_CSC_MIXIN_STACK_PUSHED|NSF_CSC_FILTER_STACK_PUSHED|NSF_CSC_IMMEDIATE|NSF_CSC_UNKNOWN|NSF_CSC_ACTIVE_FILTER) /* flags for call method */ #define NSF_CM_NO_UNKNOWN 1 Index: generic/nsfStack.c =================================================================== diff -u -r3dc0790960d69f641ccc7d52ead8bcf6c4db1830 -r2fa3f1c596fedf924397e424b532d7f223c8b621 --- generic/nsfStack.c (.../nsfStack.c) (revision 3dc0790960d69f641ccc7d52ead8bcf6c4db1830) +++ generic/nsfStack.c (.../nsfStack.c) (revision 2fa3f1c596fedf924397e424b532d7f223c8b621) @@ -447,9 +447,10 @@ *---------------------------------------------------------------------- */ static NsfCallStackContent * -CscAlloc(Tcl_Interp *interp, NsfCallStackContent *cscPtr, Tcl_ObjCmdProc *proc) { - +CscAlloc(Tcl_Interp *interp, NsfCallStackContent *cscPtr, Tcl_Command cmd) { #if defined(NRE) + Tcl_ObjCmdProc *proc = cmd ? Tcl_Command_objProc(cmd) : NULL; + if (proc == TclObjInterpProc) { cscPtr = (NsfCallStackContent *) NsfTclStackAlloc(interp, sizeof(NsfCallStackContent), "csc"); cscPtr->callType = NSF_CSC_CALL_IS_NRE; @@ -460,6 +461,7 @@ cscPtr->callType = 0; #endif + /*fprintf(stderr, "CscAlloc allocated %p\n",cscPtr);*/ return cscPtr; } @@ -481,51 +483,63 @@ NSF_INLINE static void CscInit(/*@notnull@*/ NsfCallStackContent *cscPtr, NsfObject *object, NsfClass *cl, - Tcl_Command cmd, int frameType) { + Tcl_Command cmd, int frameType, char *msg) { assert(cscPtr); - /* - * Some csc's are never stacked. We flag this case by setting self - * to NULL. This cscPtr should never appear on the stack. - */ - if (cmd && Tcl_Command_objClientData(cmd) == NULL && !(Tcl_Command_flags(cmd) & NSF_CMD_NONLEAF_METHOD)) { - /*fprintf(stderr, "+++ no CscInit needed\n");*/ - //cscPtr->self = NULL; - //return; - } + if (cmd) { + /* + * When cmd is provided, the call is not an unknown, the method + * will be executed and the object will be stacked. In these + * cases, we maintain an activation count. The fact that the + * activation cound was incremented for this frame is noted via + * NSF_CSC_OBJECT_ACTIVATED; callType is initialized in + * CscAlloc() + */ - /* - * track object activations - */ - object->activationCount ++; - //fprintf(stderr, "activationCount ++ (%s) --> %d\n",objectName(object), object->activationCount); - /* - * track class activations - */ - if (cl) { - Namespace *nsPtr = ((Command *)cmd)->nsPtr; - cl->object.activationCount ++; - /*fprintf(stderr, "... %s cmd %s cmd ns %p (%s, refCount %d ++) obj ns %p parent %p\n", - className(cl), - Tcl_GetCommandName(object->teardown, cmd), - nsPtr, nsPtr->fullName, nsPtr->refCount, - cl->object.nsPtr,cl->object.nsPtr ? ((Namespace*)cl->object.nsPtr)->parentPtr : NULL);*/ + cscPtr->callType |= NSF_CSC_OBJECT_ACTIVATED; + + // TODO + /* + * Some csc's are never stacked. We flag this case by setting self + * to NULL. This cscPtr should never appear on the stack. + */ + if (Tcl_Command_objClientData(cmd) == NULL && !(Tcl_Command_flags(cmd) & NSF_CMD_NONLEAF_METHOD)) { + /*fprintf(stderr, "+++ no CscInit needed\n");*/ + //cscPtr->self = NULL; + //return; + } - /* incremement the namespace ptr in case tcl tries to delete this namespace - during the invocation */ - nsPtr->refCount ++; + /* + * track object activations + */ + object->activationCount ++; + //fprintf(stderr, "activationCount ++ (%s) --> %d\n",objectName(object), object->activationCount); + /* + * track class activations + */ + if (cl && cmd) { + Namespace *nsPtr = ((Command *)cmd)->nsPtr; + cl->object.activationCount ++; + /*fprintf(stderr, "... %s cmd %s cmd ns %p (%s, refCount %d ++) obj ns %p parent %p\n", + className(cl), + Tcl_GetCommandName(object->teardown, cmd), + nsPtr, nsPtr->fullName, nsPtr->refCount, + cl->object.nsPtr,cl->object.nsPtr ? ((Namespace*)cl->object.nsPtr)->parentPtr : NULL);*/ + + /* incremement the namespace ptr in case tcl tries to delete this namespace + during the invocation */ + nsPtr->refCount ++; + } + } - - /* fprintf(stderr, "incr activationCount for %s to %d\n", objectName(object), object->activationCount); */ cscPtr->self = object; cscPtr->cl = cl; cscPtr->cmdPtr = cmd; cscPtr->frameType = frameType; - //cscPtr->callType = 0; /* initialized in CscAlloc() - cscPtr->filterStackEntry = frameType == NSF_CSC_TYPE_ACTIVE_FILTER ? object->filterStack : NULL; + cscPtr->filterStackEntry = (frameType == NSF_CSC_TYPE_ACTIVE_FILTER) ? object->filterStack : NULL; cscPtr->objv = NULL; - + #if defined(TCL85STACK_TRACE) fprintf(stderr, "PUSH csc %p type %d obj %s, self=%p cmd=%p (%s) id=%p (%s) obj refcount %d name refcount %d\n", cscPtr, frameType, objectName(object), object, @@ -534,6 +548,8 @@ object->id ? Tcl_Command_refCount(object->id) : -100, object->cmdName->refCount ); #endif + /*fprintf(stderr, "CscInit %p (%s) object %p %s flags %.6x cmdPtr %p\n",cscPtr, msg, + object, objectName(object), cscPtr->callType, cscPtr->cmdPtr);*/ } /* @@ -553,78 +569,91 @@ */ NSF_INLINE static void CscFinish(Tcl_Interp *interp, NsfCallStackContent *cscPtr, char *msg) { - NsfObject *object = cscPtr->self; int allowDestroy = RUNTIME_STATE(interp)->exitHandlerDestroyRound != NSF_EXITHANDLER_ON_SOFT_DESTROY; + NsfObject *object; + int flags; - /*fprintf(stderr, "CscFinish %p (%s)\n",cscPtr, msg);*/ + assert(cscPtr); + assert(cscPtr->self); - assert(object); + object = cscPtr->self; + flags = cscPtr->callType; + /*fprintf(stderr, "CscFinish %p (%s) object %p %s flags %.6x cmdPtr %p\n",cscPtr, msg, + object, objectName(object), flags, cscPtr->cmdPtr);*/ + #if defined(TCL85STACK_TRACE) fprintf(stderr, "POP csc=%p, obj %s method %s (%s)\n", cscPtr, objectName(object), Tcl_GetCommandName(interp, cscPtr->cmdPtr), msg); #endif /* - tracking activations of objects - */ - object->activationCount --; - - //fprintf(stderr, "activationCount -- (%s) --> %d\n",objectName(object), object->activationCount); - - /*fprintf(stderr, "decr activationCount for %s to %d cscPtr->cl %p\n", objectName(cscPtr->self), - cscPtr->self->activationCount, cscPtr->cl);*/ - - if (object->activationCount < 1 && object->flags & NSF_DESTROY_CALLED && allowDestroy) { - CallStackDoDestroy(interp, object); - } -#if defined(OBJDELETION_TRACE) - else if (!allowDestroy) { - fprintf(stderr,"checkFree %p %s\n",object, objectName(object)); - } -#endif - - /* - tracking activations of classes - */ - if (cscPtr->cl) { - Namespace *nsPtr = cscPtr->cmdPtr ? ((Command *)(cscPtr->cmdPtr))->nsPtr : NULL; - - object = &cscPtr->cl->object; + * We cannot rely on the existence of cscPtr->cmdPtr (like in + * initialize), since the cmd might have been deleted during the + * activation. + */ + if ((flags & NSF_CSC_OBJECT_ACTIVATED)) { + /* + tracking activations of objects + */ object->activationCount --; - /* fprintf(stderr, "CscFinish cl=%p %s (%d) flags %.6x cl ns=%p cmd %p cmd ns %p\n", - object, objectName(object), object->activationCount, object->flags, cscPtr->cl->nsPtr, - cscPtr->cmdPtr, ((Command *)cscPtr->cmdPtr)->nsPtr); */ - - /*fprintf(stderr, "CscFinish check ac %d flags %.6x\n", - object->activationCount, object->flags & NSF_DESTROY_CALLED);*/ - + + /*fprintf(stderr, "... activationCount -- (%s) --> %d\n",objectName(object), object->activationCount);*/ + + /*fprintf(stderr, "decr activationCount for %s to %d cscPtr->cl %p\n", objectName(cscPtr->self), + cscPtr->self->activationCount, cscPtr->cl);*/ + assert(object->activationCount > -1); if (object->activationCount < 1 && object->flags & NSF_DESTROY_CALLED && allowDestroy) { CallStackDoDestroy(interp, object); - } + } #if defined(OBJDELETION_TRACE) else if (!allowDestroy) { fprintf(stderr,"checkFree %p %s\n",object, objectName(object)); } #endif - - if (nsPtr) { - nsPtr->refCount--; - /*fprintf(stderr, "CscFinish parent %s activationCount %d flags %.4x refCount %d\n", - nsPtr->fullName, nsPtr->activationCount, nsPtr->flags, nsPtr->refCount);*/ - if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) { - /* the namespace refcount has reached 0, we have to free - it. unfortunately, NamespaceFree() is not exported */ - /* TODO: remove me finally */ - fprintf(stderr, "HAVE TO FREE %p\n",nsPtr); - /*NamespaceFree(nsPtr);*/ - ckfree(nsPtr->fullName); - ckfree(nsPtr->name); - ckfree((char*)nsPtr); + /* + tracking activations of classes + */ + if (cscPtr->cl) { + Namespace *nsPtr = cscPtr->cmdPtr ? ((Command *)(cscPtr->cmdPtr))->nsPtr : NULL; + + object = &cscPtr->cl->object; + object->activationCount --; + /*fprintf(stderr, "CscFinish cl=%p %s (%d) flags %.6x cl ns=%p cmd %p cmd ns %p\n", + object, objectName(object), object->activationCount, object->flags, cscPtr->cl->nsPtr, + cscPtr->cmdPtr, ((Command *)cscPtr->cmdPtr)->nsPtr); */ + + /*fprintf(stderr, "CscFinish check ac %d flags %.6x\n", + object->activationCount, object->flags & NSF_DESTROY_CALLED);*/ + + if (object->activationCount < 1 && object->flags & NSF_DESTROY_CALLED && allowDestroy) { + CallStackDoDestroy(interp, object); + } +#if defined(OBJDELETION_TRACE) + else if (!allowDestroy) { + fprintf(stderr,"checkFree %p %s\n",object, objectName(object)); } +#endif + // TODO do we have a leak now? + if (0 && nsPtr) { + nsPtr->refCount--; + /*fprintf(stderr, "CscFinish parent %s activationCount %d flags %.4x refCount %d\n", + nsPtr->fullName, nsPtr->activationCount, nsPtr->flags, nsPtr->refCount);*/ + + if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) { + /* the namespace refcount has reached 0, we have to free + it. unfortunately, NamespaceFree() is not exported */ + /* TODO: remove me finally */ + fprintf(stderr, "HAVE TO FREE %p\n",nsPtr); + /*NamespaceFree(nsPtr);*/ + ckfree(nsPtr->fullName); + ckfree(nsPtr->name); + ckfree((char*)nsPtr); + } + } + } - } #if defined(NRE) Index: generic/tclAPI.h =================================================================== diff -u -r79c263a13be8850014d056153956f5a83dfbb639 -r2fa3f1c596fedf924397e424b532d7f223c8b621 --- generic/tclAPI.h (.../tclAPI.h) (revision 79c263a13be8850014d056153956f5a83dfbb639) +++ generic/tclAPI.h (.../tclAPI.h) (revision 2fa3f1c596fedf924397e424b532d7f223c8b621) @@ -160,6 +160,8 @@ static int NsfConfigureCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfCreateObjectSystemCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfCurrentCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int NsfDebugRunAssertionsCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int NsfDebugYiedCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfDeprecatedCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfDispatchCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfExistsVarCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -180,7 +182,6 @@ static int NsfRelationCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfSetVarCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfSetterCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); -static int NsfYiedCheckCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfOAutonameMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfOCleanupMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int NsfOConfigureMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -242,6 +243,8 @@ static int NsfConfigureCmd(Tcl_Interp *interp, int configureoption, Tcl_Obj *value); static int NsfCreateObjectSystemCmd(Tcl_Interp *interp, Tcl_Obj *rootClass, Tcl_Obj *rootMetaClass, Tcl_Obj *systemMethods); static int NsfCurrentCmd(Tcl_Interp *interp, int currentoption); +static int NsfDebugRunAssertionsCmd(Tcl_Interp *interp); +static int NsfDebugYiedCmd(Tcl_Interp *interp); static int NsfDeprecatedCmd(Tcl_Interp *interp, CONST char *what, CONST char *oldCmd, CONST char *newCmd); static int NsfDispatchCmd(Tcl_Interp *interp, NsfObject *object, int withObjscope, Tcl_Obj *command, int nobjc, Tcl_Obj *CONST nobjv[]); static int NsfExistsVarCmd(Tcl_Interp *interp, NsfObject *object, CONST char *var); @@ -262,7 +265,6 @@ static int NsfRelationCmd(Tcl_Interp *interp, NsfObject *object, int relationtype, Tcl_Obj *value); static int NsfSetVarCmd(Tcl_Interp *interp, NsfObject *object, Tcl_Obj *variable, Tcl_Obj *value); static int NsfSetterCmd(Tcl_Interp *interp, NsfObject *object, int withPer_object, Tcl_Obj *parameter); -static int NsfYiedCheckCmd(Tcl_Interp *interp); static int NsfOAutonameMethod(Tcl_Interp *interp, NsfObject *obj, int withInstance, int withReset, Tcl_Obj *name); static int NsfOCleanupMethod(Tcl_Interp *interp, NsfObject *obj); static int NsfOConfigureMethod(Tcl_Interp *interp, NsfObject *obj, int objc, Tcl_Obj *CONST objv[]); @@ -325,6 +327,8 @@ NsfConfigureCmdIdx, NsfCreateObjectSystemCmdIdx, NsfCurrentCmdIdx, + NsfDebugRunAssertionsCmdIdx, + NsfDebugYiedCmdIdx, NsfDeprecatedCmdIdx, NsfDispatchCmdIdx, NsfExistsVarCmdIdx, @@ -345,7 +349,6 @@ NsfRelationCmdIdx, NsfSetVarCmdIdx, NsfSetterCmdIdx, - NsfYiedCheckCmdIdx, NsfOAutonameMethodIdx, NsfOCleanupMethodIdx, NsfOConfigureMethodIdx, @@ -927,6 +930,42 @@ } static int +NsfDebugRunAssertionsCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + ParseContext pc; + + if (ArgumentParse(interp, objc, objv, NULL, objv[0], + method_definitions[NsfDebugRunAssertionsCmdIdx].paramDefs, + method_definitions[NsfDebugRunAssertionsCmdIdx].nrParameters, 1, + &pc) != TCL_OK) { + return TCL_ERROR; + } else { + + + ParseContextRelease(&pc); + return NsfDebugRunAssertionsCmd(interp); + + } +} + +static int +NsfDebugYiedCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + ParseContext pc; + + if (ArgumentParse(interp, objc, objv, NULL, objv[0], + method_definitions[NsfDebugYiedCmdIdx].paramDefs, + method_definitions[NsfDebugYiedCmdIdx].nrParameters, 1, + &pc) != TCL_OK) { + return TCL_ERROR; + } else { + + + ParseContextRelease(&pc); + return NsfDebugYiedCmd(interp); + + } +} + +static int NsfDeprecatedCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { ParseContext pc; @@ -1324,24 +1363,6 @@ } static int -NsfYiedCheckCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - ParseContext pc; - - if (ArgumentParse(interp, objc, objv, NULL, objv[0], - method_definitions[NsfYiedCheckCmdIdx].paramDefs, - method_definitions[NsfYiedCheckCmdIdx].nrParameters, 1, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - - - ParseContextRelease(&pc); - return NsfYiedCheckCmd(interp); - - } -} - -static int NsfOAutonameMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { ParseContext pc; NsfObject *obj = (NsfObject *)clientData; @@ -2101,6 +2122,12 @@ {"::nsf::current", NsfCurrentCmdStub, 1, { {"currentoption", 0, 0, ConvertToCurrentoption}} }, +{"::nsf::__db_run_assertions", NsfDebugRunAssertionsCmdStub, 0, { + } +}, +{"::nsf::__db__yield", NsfDebugYiedCmdStub, 0, { + } +}, {"::nsf::deprecated", NsfDeprecatedCmdStub, 3, { {"what", 1, 0, ConvertToString}, {"oldCmd", 1, 0, ConvertToString}, @@ -2203,9 +2230,6 @@ {"-per-object", 0, 0, ConvertToString}, {"parameter", 0, 0, ConvertToTclobj}} }, -{"::nsf::yieldcheck", NsfYiedCheckCmdStub, 0, { - } -}, {"::nsf::cmd::Object::autoname", NsfOAutonameMethodStub, 3, { {"-instance", 0, 0, ConvertToString}, {"-reset", 0, 0, ConvertToString}, Index: library/xotcl/tests/testx.xotcl =================================================================== diff -u -rac7af6dddd0ab0b13bfd0d1f4b1a829326f045a3 -r2fa3f1c596fedf924397e424b532d7f223c8b621 --- library/xotcl/tests/testx.xotcl (.../testx.xotcl) (revision ac7af6dddd0ab0b13bfd0d1f4b1a829326f045a3) +++ library/xotcl/tests/testx.xotcl (.../testx.xotcl) (revision 2fa3f1c596fedf924397e424b532d7f223c8b621) @@ -2,6 +2,7 @@ package require XOTcl; namespace import ::xotcl::* proc ::errorCheck {got expected msg} { + nsf::__db_run_assertions if {$got != $expected} { if {[catch self self]} { set self "NO CURRENT OBJECT" @@ -773,15 +774,24 @@ B instfilter {{f1 -guard {[self] eq "::b"}} {f2 -guard 0} f1} b filter {{f1 -guard {[self] eq "::b"}} {f2 -guard 0}} - ::errorCheck [B info instfilter]-[B info instfilter -guards]-[b info filter]-[b info filter -guards] \ - {f1 f2-f1 {f2 -guard 0}-f1 f2-{f1 -guard {[self] eq "::b"}} {f2 -guard 0}}\ - {[self] -- Filter guard: -guards option} + ::errorCheck [B info instfilter] {f1 f2} "info filter order a" + ::errorCheck [B info instfilter -guards] {f1 {f2 -guard 0}} "info filter order b" + ::errorCheck [b info filter] {f1 f2} "info filter order c" + ::errorCheck [b info filter -guards] {{f1 -guard {[self] eq "::b"}} {f2 -guard 0}} "info filter order d" A instfilter {f1 fx} A a + puts stderr ====created + nsf::__db_run_assertions + puts stderr ==== a proc x args {next} a filter x + ::errorCheck [b info filter -order] \ + "{::B instproc f1} {::B instproc f2} {::A instproc f1} {::A instproc fx}" "info filter-order- 2a" + ::errorCheck [a info filter -order] \ + "{::a proc x} {::A instproc f1} {::A instproc fx}" "info filter-order- 2b" + ::errorCheck [b info filter -order]-[a info filter -order] "{::B instproc f1} {::B instproc f2} {::A instproc f1} {::A instproc fx}-{::a proc x} {::A instproc f1} {::A instproc fx}" \ {[self] -- Filter guard: -order option} @@ -2846,18 +2856,19 @@ } TestX recreation -proc run {{n 10}} { - for {set i 0} {$i < $n} {incr i} { - set ::recreateResult "" - Class R - R instproc recreate args { - global recreateResult - append recreateResult "*recreate [self] $args* " - set r [next] - append recreateResult "*recreate [self] <[lindex $args 0]> $r * " - return $r - } - Object instmixin R + for {set i 0} {$i < $n} {incr i} { + set ::recreateResult "" + Class R + R instproc recreate args { + global recreateResult + append recreateResult "*recreate [self] $args* " + set r [next] + append recreateResult "*recreate [self] <[lindex $args 0]> $r * " + return $r + } + Object instmixin R + catch { C destroy c1 destroy @@ -2934,6 +2945,8 @@ catch {X destroy} catch {META destroy} + nsf::__db_run_assertions + Class A A proc dealloc args {append ::cleanupResult " [self]+[self class]->[self proc]"; next} A proc recreate args {append ::cleanupResult " [self]+[self class]->[self proc]"; next} @@ -2950,7 +2963,7 @@ errorCheck [set ::cleanupResult] \ " ::A+->recreate ::a+::A->cleanup ::a::b+::A->destroy ::A+->dealloc" \ "Cleanup a/a::b Failed (n)" - a destroy; + a destroy set ::cleanupResult "" A instproc cleanup args {append ::cleanupResult " [self]+[self class]->[self proc]"} @@ -2968,6 +2981,7 @@ a destroy set ::cleanupResult "" + nsf::__db_run_assertions Class META -superclass Class META proc dealloc args {append ::cleanupResult " [self]+[self class]->[self proc]"; next}