From d98553d4645b44a9e51415ccf4310a5a5ba00cd8 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 15 Dec 2009 18:12:06 +0000 Subject: * generic/tkConfig.c: Added another dimension of refCounting to the * generic/tkInt.c: "option" Tcl_ObjType to improve memory troubles * generic/tkObj.c: detailed in [Bug 2492179]. Also removed registration of the "option" Tcl_ObjType. *** POTENTIAL INCOMPATIBILITY *** for callers of Tcl_GetObjType("option") which must now handle a NULL return. --- ChangeLog | 9 +++++++++ generic/tkConfig.c | 55 ++++++++++++++++++++++++++++++++++++++++++++++++------ generic/tkInt.h | 3 +-- generic/tkObj.c | 3 +-- 4 files changed, 60 insertions(+), 10 deletions(-) diff --git a/ChangeLog b/ChangeLog index 67022b7..23f5e8a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2009-12-15 Don Porter + + * generic/tkConfig.c: Added another dimension of refCounting to the + * generic/tkInt.c: "option" Tcl_ObjType to improve memory troubles + * generic/tkObj.c: detailed in [Bug 2492179]. Also removed + registration of the "option" Tcl_ObjType. + *** POTENTIAL INCOMPATIBILITY *** for callers of + Tcl_GetObjType("option") which must now handle a NULL return. + 2009-12-15 Donal K. Fellows * library/demos/unicodeout.tcl (usePresentationFormsFor): Split out diff --git a/generic/tkConfig.c b/generic/tkConfig.c index ccdfdb0..d220423 100644 --- a/generic/tkConfig.c +++ b/generic/tkConfig.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkConfig.c,v 1.31 2009/06/30 00:56:29 das Exp $ + * RCS: @(#) $Id: tkConfig.c,v 1.32 2009/12/15 18:12:07 dgp Exp $ */ /* @@ -102,6 +102,8 @@ typedef struct OptionTable { * chain. */ int numOptions; /* The number of items in the options array * below. */ + int refCount2; /* Reference counter for controlling the freeing + * of the memory occupied by this OptionTable */ Option options[1]; /* Information about the individual options in * the table. This must be the last field in * the structure: the actual size of the array @@ -127,6 +129,7 @@ static Option * GetOption(const char *name, OptionTable *tablePtr); static Option * GetOptionFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, OptionTable *tablePtr); static int ObjectIsEmpty(Tcl_Obj *objPtr); +static void FreeOptionInternalRep(Tcl_Obj *objPtr); static int SetOptionFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); /* @@ -136,9 +139,9 @@ static int SetOptionFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); * the internalPtr2 field points to the entry that matched. */ -const Tcl_ObjType tkOptionObjType = { +static const Tcl_ObjType optionObjType = { "option", /* name */ - NULL, /* freeIntRepProc */ + FreeOptionInternalRep, /* freeIntRepProc */ NULL, /* dupIntRepProc */ NULL, /* updateStringProc */ SetOptionFromAny /* setFromAnyProc */ @@ -222,6 +225,7 @@ Tk_CreateOptionTable( tablePtr = (OptionTable *) (ckalloc(sizeof(OptionTable) + (numOptions * sizeof(Option)))); tablePtr->refCount = 1; + tablePtr->refCount2 = 1; tablePtr->hashEntryPtr = hashEntryPtr; tablePtr->nextPtr = NULL; tablePtr->numOptions = numOptions; @@ -357,7 +361,10 @@ Tk_DeleteOptionTable( } } Tcl_DeleteHashEntry(tablePtr->hashEntryPtr); - ckfree((char *) tablePtr); + tablePtr->refCount2--; + if (tablePtr->refCount2 <= 0) { + ckfree((char *) tablePtr); + } } /* @@ -1130,7 +1137,7 @@ GetOptionFromObj( * First, check to see if the object already has the answer cached. */ - if (objPtr->typePtr == &tkOptionObjType) { + if (objPtr->typePtr == &optionObjType) { if (objPtr->internalRep.twoPtrValue.ptr1 == (void *) tablePtr) { return (Option *) objPtr->internalRep.twoPtrValue.ptr2; } @@ -1152,7 +1159,8 @@ GetOptionFromObj( } objPtr->internalRep.twoPtrValue.ptr1 = (void *) tablePtr; objPtr->internalRep.twoPtrValue.ptr2 = (void *) bestPtr; - objPtr->typePtr = &tkOptionObjType; + objPtr->typePtr = &optionObjType; + tablePtr->refCount2++; return bestPtr; error: @@ -1229,6 +1237,41 @@ SetOptionFromAny( NULL); return TCL_ERROR; } + +/* + *---------------------------------------------------------------------- + * + * FreeOptionInternalRep -- + * + * Part of the option Tcl object type implementation. Frees the storage + * associated with a option object's internal representation unless it + * is still in use. + * + * Results: + * None. + * + * Side effects: + * The option object's internal rep is marked invalid and its memory + * gets freed unless it is still in use somewhere. In that case the + * cleanup is delayed until the last reference goes away. + * + *---------------------------------------------------------------------- + */ + +static void +FreeOptionInternalRep( + register Tcl_Obj *objPtr) /* Object whose internal rep to free. */ +{ + register OptionTable *tablePtr = (OptionTable *) objPtr->internalRep.twoPtrValue.ptr1; + + tablePtr->refCount2--; + if (tablePtr->refCount2 <= 0) { + ckfree((char *)tablePtr); + } + objPtr->typePtr = NULL; + objPtr->internalRep.twoPtrValue.ptr1 = NULL; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; +} /* *-------------------------------------------------------------- diff --git a/generic/tkInt.h b/generic/tkInt.h index 81e3967..ee9441e 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: $Id: tkInt.h,v 1.114 2009/12/09 10:45:30 dkf Exp $ + * RCS: $Id: tkInt.h,v 1.115 2009/12/15 18:12:07 dgp Exp $ */ #ifndef _TKINT @@ -926,7 +926,6 @@ MODULE_SCOPE const Tcl_ObjType tkBitmapObjType; MODULE_SCOPE const Tcl_ObjType tkColorObjType; MODULE_SCOPE const Tcl_ObjType tkCursorObjType; MODULE_SCOPE const Tcl_ObjType tkFontObjType; -MODULE_SCOPE const Tcl_ObjType tkOptionObjType; MODULE_SCOPE const Tcl_ObjType tkStateKeyObjType; MODULE_SCOPE const Tcl_ObjType tkTextIndexType; diff --git a/generic/tkObj.c b/generic/tkObj.c index d3ce270..e78d7d2 100644 --- a/generic/tkObj.c +++ b/generic/tkObj.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkObj.c,v 1.26 2009/02/03 23:55:47 nijtmans Exp $ + * RCS: @(#) $Id: tkObj.c,v 1.27 2009/12/15 18:12:07 dgp Exp $ */ #include "tkInt.h" @@ -1075,7 +1075,6 @@ TkRegisterObjTypes(void) Tcl_RegisterObjType(&tkCursorObjType); Tcl_RegisterObjType(&tkFontObjType); Tcl_RegisterObjType(&mmObjType); - Tcl_RegisterObjType(&tkOptionObjType); Tcl_RegisterObjType(&pixelObjType); Tcl_RegisterObjType(&tkStateKeyObjType); Tcl_RegisterObjType(&windowObjType); -- cgit v0.12