Index: TODO =================================================================== diff -u -r05d94a270a6c11715c96ddbbe441160e9fd63d42 -r6889109b1238e52796b59d0f35b81e00f9f268cf --- TODO (.../TODO) (revision 05d94a270a6c11715c96ddbbe441160e9fd63d42) +++ TODO (.../TODO) (revision 6889109b1238e52796b59d0f35b81e00f9f268cf) @@ -3095,27 +3095,21 @@ to scalar case * extended regression test +- nsf.c: + * fixing compliation with NSF_MEM_COUNT + * New function DeleteProcsAndVars() to trigger deletion of + ParamDefs (fixes a small mmemory leak); + * improved comments + + + TODO: - add "delete variable" analogous to "delete attribute" - interface of "variable" and "attribute": * add switch -array for "variable"? * should we switch from "-class" to "-slotclass"? * should we change interface for default value in attribute? probably not, same interface is used in methodparameters as well - - - Should we leave "variable" and "attribute" as it is, or - switch the names to something better? Some options: - - - [obj/cls info method handle "FOO foo"] does neither return a proper - submethod handle nor any valid handle ... needs a fix. - - - NsfObjWrongArgs() & friends is not aware of submethods. Error - messages print with the leaf method names only, e.g.: "anObj method - ..." instead of " anObj info method ..." etc. - - - variable and incremental, test for user-defined types - - should we change interface for default value in attribute? - probably not, same interface is used in methodparameters as well - Should we leave "variable" and "attribute" as it ist? options: (a) leave it as it is @@ -3130,6 +3124,13 @@ (e) others? - call user defined setter in object parameters? + - [obj/cls info method handle "FOO foo"] does neither return a proper + submethod handle nor any valid handle ... needs a fix. + + - NsfObjWrongArgs() & friends is not aware of submethods. Error + messages print with the leaf method names only, e.g.: "anObj method + ..." instead of " anObj info method ..." etc. + - Revise callstack introspection/intercession, i.e., [current activelevel] vs. [current callinglevel] vs. uplevel()/upvar(): Index: generic/nsf.c =================================================================== diff -u -r05d94a270a6c11715c96ddbbe441160e9fd63d42 -r6889109b1238e52796b59d0f35b81e00f9f268cf --- generic/nsf.c (.../nsf.c) (revision 05d94a270a6c11715c96ddbbe441160e9fd63d42) +++ generic/nsf.c (.../nsf.c) (revision 6889109b1238e52796b59d0f35b81e00f9f268cf) @@ -289,7 +289,11 @@ static Tcl_Command GetOriginalCommand(Tcl_Command cmd); void NsfDStringArgv(Tcl_DString *dsPtr, int objc, Tcl_Obj *CONST objv[]); static int MethodSourceMatches(int withSource, NsfClass *cl, NsfObject *object); +static void DeleteNsfProcs(Tcl_Interp *interp, Tcl_Namespace *nsPtr); +#ifdef DO_FULL_CLEANUP +static void DeleteProcsAndVars(Tcl_Interp *interp); +#endif /* *---------------------------------------------------------------------- @@ -2312,7 +2316,7 @@ FinalObjectDeletion(interp, &osPtr->rootMetaClass->object); } - FREE(NsfObjectSystem *, osPtr); + FREE(NsfObjectSystem, osPtr); } /* @@ -2534,6 +2538,11 @@ ObjectSystemFree(interp, osPtr); } +#ifdef DO_CLEANUP + /* finally, free all nsfprocs */ + DeleteNsfProcs(interp, NULL); +#endif + return TCL_OK; } @@ -7622,6 +7631,21 @@ return TCL_ERROR; } +/* + *---------------------------------------------------------------------- + * ParamDefsNew -- + * + * Allocate a new paramDefs structure and initialize it with zeros. The + * allocated structure should be freed with ParamDefsFree(). + * + * Results: + * pointer to paramDefs structure + * + * Side effects: + * Allocating memory + * + *---------------------------------------------------------------------- + */ static NsfParamDefs * ParamDefsNew() { NsfParamDefs *paramDefs; @@ -10494,7 +10518,7 @@ param_error: ckfree((char *)paramPtr->name); - paramPtr->name = NULL + paramPtr->name = NULL; DECR_REF_COUNT(paramPtr->nameObj); return TCL_ERROR; } @@ -10586,8 +10610,8 @@ paramDefs = ParamDefsNew(); paramDefs->paramsPtr = paramsPtr; paramDefs->nrParams = paramPtr-paramsPtr; - /*fprintf(stderr, "method %s ifsize %d, possible unknowns = %d,\n", - procName, paramPtr-paramDefsPtr, possibleUnknowns);*/ + /*fprintf(stderr, "method %s paramDefs %p ifsize %ld, possible unknowns = %d,\n", + ObjStr(procNameObj), paramDefs, paramPtr-paramsPtr, possibleUnknowns);*/ parsedParamPtr->paramDefs = paramDefs; parsedParamPtr->possibleUnknowns = possibleUnknowns; } @@ -16583,6 +16607,8 @@ # endif /*fprintf(stderr, "CLEANUP TOP NS\n");*/ Tcl_Export(interp, RUNTIME_STATE(interp)->NsfNS, "", 1); + MEM_COUNT_FREE("TclNamespace",RUNTIME_STATE(interp)->NsfClassesNS); + MEM_COUNT_FREE("TclNamespace",RUNTIME_STATE(interp)->NsfNS); Tcl_DeleteNamespace(RUNTIME_STATE(interp)->NsfClassesNS); Tcl_DeleteNamespace(RUNTIME_STATE(interp)->NsfNS); #endif @@ -17123,7 +17149,9 @@ ParamDefsStore(cmd, paramDefs); /*fprintf(stderr, "new param defs %p for cmd %p %s\n", paramDefs, cmd, methodName);*/ } - objPtr = methodproperty == MethodpropertySlotobjIdx ? ¶mDefs->slotObj : ¶mDefs->returns; + objPtr = + methodproperty == MethodpropertySlotobjIdx ? + ¶mDefs->slotObj : ¶mDefs->returns; /* Set a new value; if there is already a value, free it */ if (*objPtr) { @@ -20503,7 +20531,7 @@ if (withSource == 0) {withSource = 1;} Tcl_InitHashTable(&slotTable, TCL_STRING_KEYS); - MEM_COUNT_ALLOC("Tcl_InitHashTable", slotTable); + MEM_COUNT_ALLOC("Tcl_InitHashTable", &slotTable); /* * First add the per-object slot objects @@ -20524,7 +20552,7 @@ } Tcl_DeleteHashTable(&slotTable); - MEM_COUNT_FREE("Tcl_InitHashTable", slotTable); + MEM_COUNT_FREE("Tcl_InitHashTable", &slotTable); NsfClassListFree(precendenceList); Tcl_SetObjResult(interp, listObj); @@ -21123,7 +21151,7 @@ * Use a hash table to eliminate potential duplicates. */ Tcl_InitHashTable(&slotTable, TCL_STRING_KEYS); - MEM_COUNT_ALLOC("Tcl_InitHashTable", slotTable); + MEM_COUNT_ALLOC("Tcl_InitHashTable", &slotTable); for (clPtr = precedenceList; clPtr; clPtr = clPtr->nextPtr) { if (MethodSourceMatches(withSource, clPtr->cl, NULL)) { @@ -21133,7 +21161,7 @@ } Tcl_DeleteHashTable(&slotTable); - MEM_COUNT_FREE("Tcl_InitHashTable", slotTable); + MEM_COUNT_FREE("Tcl_InitHashTable", &slotTable); NsfClassListFree(precedenceList); Tcl_SetObjResult(interp, listObj); @@ -21195,13 +21223,15 @@ static void DeleteProcsAndVars(Tcl_Interp *interp) { Tcl_Namespace *nsPtr = Tcl_GetGlobalNamespace(interp); - Tcl_HashTable *varTablePtr = nsPtr ? Tcl_Namespace_varTablePtr(ns) : NULL; - Tcl_HashTable *cmdTablePtr = nsPtr ? Tcl_Namespace_cmdTablePtr(ns) : NULL; + Tcl_HashTable *varTablePtr = nsPtr ? (Tcl_HashTable *)Tcl_Namespace_varTablePtr(nsPtr) : NULL; + Tcl_HashTable *cmdTablePtr = nsPtr ? Tcl_Namespace_cmdTablePtr(nsPtr) : NULL; Tcl_HashSearch search; Var *varPtr; Tcl_Command cmd; register Tcl_HashEntry *entryPtr; + fprintf(stderr, "DeleteProcsAndVars\n"); + for (entryPtr = Tcl_FirstHashEntry(varTablePtr, &search); entryPtr; entryPtr = Tcl_NextHashEntry(&search)) { Tcl_Obj *nameObj; @@ -21228,17 +21258,114 @@ #ifdef DO_CLEANUP +/* + *---------------------------------------------------------------------- + * + * DeleteNsfProcs -- + * + * Delete all nsfprocs in the namespaces rooted by the second + * argument. If it is NULL, the globale namespace is used a root of the + * namespace tree. The function is necessary to trigger the freeing of + * the parameter defs. + * + * Results: + * None. + * + * Side effects: + * Deletion of nsfprocs. + * + *---------------------------------------------------------------------- + */ +static void +DeleteNsfProcs(Tcl_Interp *interp, Tcl_Namespace *nsPtr) { + Tcl_HashTable *cmdTablePtr, *childTablePtr; + register Tcl_HashEntry *entryPtr; + Tcl_HashSearch search; + Tcl_Command cmd; + + if (nsPtr == NULL) { + nsPtr = Tcl_GetGlobalNamespace(interp); + } + + assert(nsPtr); + /*fprintf(stderr, "### DeleteNsfProcs current namespace '%s'\n", + nsPtr ? nsPtr->fullName : "NULL");*/ + + cmdTablePtr = Tcl_Namespace_cmdTablePtr(nsPtr); + childTablePtr = Tcl_Namespace_childTablePtr(nsPtr); + + for (entryPtr = Tcl_FirstHashEntry(cmdTablePtr, &search); entryPtr; + entryPtr = Tcl_NextHashEntry(&search)) { + cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr); + if (Tcl_Command_objProc(cmd) == NsfProcStub) { + /*fprintf(stderr, "cmdname = %s cmd %p\n", + Tcl_GetHashKey(cmdTablePtr, entryPtr), cmd);*/ + Tcl_DeleteCommandFromToken(interp, cmd); + } + } + for (entryPtr = Tcl_FirstHashEntry(childTablePtr, &search); entryPtr; + entryPtr = Tcl_NextHashEntry(&search)) { + Tcl_Namespace *childNsPtr = (Tcl_Namespace *) Tcl_GetHashValue(entryPtr); + DeleteNsfProcs(interp, childNsPtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * ClassHasSubclasses -- + * + * Check, whether the given class has subclasses. + * + * Results: + * boolean + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ static int ClassHasSubclasses(NsfClass *cl) { return (cl->sub != NULL); } +/* + *---------------------------------------------------------------------- + * + * ClassHasInstances -- + * + * Check, whether the given class has instances. + * + * Results: + * boolean + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ static int ClassHasInstances(NsfClass *cl) { Tcl_HashSearch hSrch; return (Tcl_FirstHashEntry(&cl->instances, &hSrch) != NULL); } +/* + *---------------------------------------------------------------------- + * + * ObjectHasChildren -- + * + * Check, whether the given object has children + * + * Results: + * boolean + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ static int ObjectHasChildren(NsfObject *object) { Tcl_Namespace *ns = object->nsPtr; @@ -21485,6 +21612,9 @@ NsfProfileFree(interp); #endif + FREE(Tcl_Obj**, NsfGlobalObjs); + FREE(NsfRuntimeState, RUNTIME_STATE(interp)); + #if defined(TCL_MEM_DEBUG) TclDumpMemoryInfo((ClientData) stderr, 0); Tcl_DumpActiveMemory("./nsfActiveMem"); @@ -21493,9 +21623,6 @@ #endif MEM_COUNT_DUMP(); - FREE(Tcl_Obj**, NsfGlobalObjs); - FREE(NsfRuntimeState, RUNTIME_STATE(interp)); - Tcl_Interp_flags(interp) = flags; Tcl_Release(interp); } Index: generic/nsf.h =================================================================== diff -u -rcef0608bea97458e5dcd87615c9b8ca3fe7b464c -r6889109b1238e52796b59d0f35b81e00f9f268cf --- generic/nsf.h (.../nsf.h) (revision cef0608bea97458e5dcd87615c9b8ca3fe7b464c) +++ generic/nsf.h (.../nsf.h) (revision 6889109b1238e52796b59d0f35b81e00f9f268cf) @@ -96,6 +96,7 @@ #define NSF_MEM_TRACE 1 #define NSF_MEM_COUNT 1 */ +//#define NSF_MEM_COUNT 1 /* turn tracing output on/off #define NSFOBJ_TRACE 1 Index: generic/nsfDecls.h =================================================================== diff -u -r1af8aba52df547aa435235e6ad307d7b97655de9 -r6889109b1238e52796b59d0f35b81e00f9f268cf --- generic/nsfDecls.h (.../nsfDecls.h) (revision 1af8aba52df547aa435235e6ad307d7b97655de9) +++ generic/nsfDecls.h (.../nsfDecls.h) (revision 6889109b1238e52796b59d0f35b81e00f9f268cf) @@ -182,7 +182,7 @@ struct NsfStubHooks *hooks; int (*nsf_Init) (Tcl_Interp *interp); /* 0 */ - void *reserved1; + VOID *reserved1; struct Nsf_Class * (*nsfIsClass) (Tcl_Interp *interp, ClientData cd); /* 2 */ struct Nsf_Object * (*nsfGetObject) (Tcl_Interp *interp, CONST char *name); /* 3 */ struct Nsf_Class * (*nsfGetClass) (Tcl_Interp *interp, CONST char *name); /* 4 */ Index: generic/nsfInt.h =================================================================== diff -u -rbf363a408bfa522970f24b06967f2091604b6d02 -r6889109b1238e52796b59d0f35b81e00f9f268cf --- generic/nsfInt.h (.../nsfInt.h) (revision bf363a408bfa522970f24b06967f2091604b6d02) +++ generic/nsfInt.h (.../nsfInt.h) (revision 6889109b1238e52796b59d0f35b81e00f9f268cf) @@ -87,7 +87,6 @@ #endif #ifdef NSF_MEM_COUNT -Tcl_HashTable nsfMemCount; extern int nsfMemCountInterpCounter; typedef struct NsfMemCounter { int peak; @@ -97,6 +96,7 @@ # define MEM_COUNT_FREE(id,p) NsfMemCountFree(id,p) # define MEM_COUNT_INIT() \ if (nsfMemCountInterpCounter == 0) { \ + extern Tcl_HashTable nsfMemCount; \ Tcl_InitHashTable(&nsfMemCount, TCL_STRING_KEYS); \ nsfMemCountInterpCounter = 1; \ } Index: generic/nsfTrace.c =================================================================== diff -u -rab5097b110d11556bd7b32faace2fd6cae23b6e5 -r6889109b1238e52796b59d0f35b81e00f9f268cf --- generic/nsfTrace.c (.../nsfTrace.c) (revision ab5097b110d11556bd7b32faace2fd6cae23b6e5) +++ generic/nsfTrace.c (.../nsfTrace.c) (revision 6889109b1238e52796b59d0f35b81e00f9f268cf) @@ -71,6 +71,9 @@ } #ifdef NSF_MEM_COUNT +Tcl_HashTable nsfMemCount; + + void NsfMemCountAlloc(char *id, void *p) { int new;