diff options
author | Miguel Sofer <miguel.sofer@gmail.com> | 2004-07-23 18:32:00 (GMT) |
---|---|---|
committer | Miguel Sofer <miguel.sofer@gmail.com> | 2004-07-23 18:32:00 (GMT) |
commit | 743d7b0174ab03d41ce1756d82f010973999b7ad (patch) | |
tree | 456bc31f0369b9b2a307106b375c0d41cb26e964 | |
parent | 4d0f5d3aadf26843ee841017d0b0086c82726b28 (diff) | |
download | tcl-743d7b0174ab03d41ce1756d82f010973999b7ad.zip tcl-743d7b0174ab03d41ce1756d82f010973999b7ad.tar.gz tcl-743d7b0174ab03d41ce1756d82f010973999b7ad.tar.bz2 |
* generic/tclVar.c: simplify tclLocalVarNameType, removing the
reference to the corresponding proc. The reference is now seen as
unnecessary, and it may cause leaking circular references under
some circumstances (see for example [Bug 994838]).
-rw-r--r-- | ChangeLog | 7 | ||||
-rw-r--r-- | generic/tclVar.c | 107 |
2 files changed, 46 insertions, 68 deletions
@@ -1,3 +1,10 @@ +2004-07-23 Miguel Sofer <msofer@users.sf.net> + + * generic/tclVar.c: simplify tclLocalVarNameType, removing the + reference to the corresponding proc. The reference is now seen as + unnecessary, and it may cause leaking circular references under + some circumstances (see for example [Bug 994838]). + 2004-07-22 Don Porter <dgp@users.sourceforge.net> * tests/eofchar.data (removed): Test io-61.1 now generates its own diff --git a/generic/tclVar.c b/generic/tclVar.c index dea92c4..4b69ce6 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.86 2004/05/27 20:44:37 msofer Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.87 2004/07/23 18:32:06 msofer Exp $ */ #ifdef STDC_HEADERS @@ -72,20 +72,20 @@ Var * TclLookupSimpleVar _ANSI_ARGS_((Tcl_Interp *interp, int TclObjUnsetVar2 _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *part1Ptr, CONST char *part2, int flags)); -static Tcl_FreeInternalRepProc FreeLocalVarName; static Tcl_DupInternalRepProc DupLocalVarName; -static Tcl_UpdateStringProc UpdateLocalVarName; static Tcl_FreeInternalRepProc FreeParsedVarName; static Tcl_DupInternalRepProc DupParsedVarName; static Tcl_UpdateStringProc UpdateParsedVarName; +static Tcl_UpdateStringProc PanicOnUpdateVarName; +static Tcl_SetFromAnyProc PanicOnSetVarName; + /* * Types of Tcl_Objs used to cache variable lookups. * * * localVarName - INTERNALREP DEFINITION: - * twoPtrValue.ptr1 = pointer to the corresponding Proc - * twoPtrValue.ptr2 = index into locals table + * longValue = index into locals table * * nsVarName - INTERNALREP DEFINITION: * twoPtrValue.ptr1: pointer to the namespace containing the @@ -102,7 +102,7 @@ static Tcl_UpdateStringProc UpdateParsedVarName; Tcl_ObjType tclLocalVarNameType = { "localVarName", - FreeLocalVarName, DupLocalVarName, UpdateLocalVarName, NULL + NULL, DupLocalVarName, PanicOnUpdateVarName, PanicOnSetVarName }; /* @@ -120,13 +120,13 @@ static Tcl_DupInternalRepProc DupNsVarName; Tcl_ObjType tclNsVarNameType = { "namespaceVarName", - FreeNsVarName, DupNsVarName, NULL, NULL + FreeNsVarName, DupNsVarName, PanicOnUpdateVarName, PanicOnSetVarName }; #endif Tcl_ObjType tclParsedVarNameType = { "parsedVarName", - FreeParsedVarName, DupParsedVarName, UpdateParsedVarName, NULL + FreeParsedVarName, DupParsedVarName, UpdateParsedVarName, PanicOnSetVarName }; /* @@ -407,17 +407,13 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, } if (typePtr == &tclLocalVarNameType) { - Proc *procPtr = (Proc *) part1Ptr->internalRep.twoPtrValue.ptr1; - ptrdiff_t localIndex = (ptrdiff_t) part1Ptr->internalRep.twoPtrValue.ptr2; - int useLocal; + int localIndex = (int) part1Ptr->internalRep.longValue; - useLocal = ((varFramePtr != NULL) && varFramePtr->isProcCallFrame - && !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))); - if (useLocal && (procPtr == varFramePtr->procPtr)) { + if ((varFramePtr != NULL) && varFramePtr->isProcCallFrame + && !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) + && (localIndex < varFramePtr->numCompiledLocals)) { /* - * part1Ptr points to an indexed local variable of the - * correct procedure: use the cached value if the names - * coincide. + * use the cached index if the names coincide. */ varPtr = &(varFramePtr->compiledLocals[localIndex]); @@ -560,8 +556,7 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, part1Ptr->typePtr = &tclLocalVarNameType; procPtr->refCount++; - part1Ptr->internalRep.twoPtrValue.ptr1 = (VOID *) procPtr; - part1Ptr->internalRep.twoPtrValue.ptr2 = (VOID *)(ptrdiff_t) index; + part1Ptr->internalRep.longValue = (long) index; #if ENABLE_NS_VARNAME_CACHING } else if (index > -3) { /* @@ -4580,69 +4575,45 @@ TclVarErrMsg(interp, part1, part2, operation, reason) *---------------------------------------------------------------------- */ -/* - * localVarName - - * - * INTERNALREP DEFINITION: - * twoPtrValue.ptr1 = pointer to the corresponding Proc - * twoPtrValue.ptr2 = index into locals table +/* + * Panic functions that should never be called in normal + * operation. */ -static void -FreeLocalVarName(objPtr) +static void +PanicOnUpdateVarName(objPtr) Tcl_Obj *objPtr; { - register Proc *procPtr = (Proc *) objPtr->internalRep.twoPtrValue.ptr1; - procPtr->refCount--; - if (procPtr->refCount <= 0) { - TclProcCleanupProc(procPtr); - } + Tcl_Panic("ERROR: updateStringProc of type %s should not be called.", + objPtr->typePtr->name); } +static int +PanicOnSetVarName(interp, objPtr) + Tcl_Interp *interp; + Tcl_Obj *objPtr; +{ + Tcl_Panic("ERROR: setFromAnyProc of type %s should not be called.", + objPtr->typePtr->name); + return TCL_ERROR; +} + +/* + * localVarName - + * + * INTERNALREP DEFINITION: + * longValue = index into locals table + */ + static void DupLocalVarName(srcPtr, dupPtr) Tcl_Obj *srcPtr; Tcl_Obj *dupPtr; { - register Proc *procPtr = (Proc *) srcPtr->internalRep.twoPtrValue.ptr1; - - dupPtr->internalRep.twoPtrValue.ptr1 = (VOID *) procPtr; - dupPtr->internalRep.twoPtrValue.ptr2 = srcPtr->internalRep.twoPtrValue.ptr2; - procPtr->refCount++; + dupPtr->internalRep.longValue = srcPtr->internalRep.longValue; dupPtr->typePtr = &tclLocalVarNameType; } -static void -UpdateLocalVarName(objPtr) - Tcl_Obj *objPtr; -{ - Proc *procPtr = (Proc *) objPtr->internalRep.twoPtrValue.ptr1; - ptrdiff_t index = (ptrdiff_t) objPtr->internalRep.twoPtrValue.ptr2; - CompiledLocal *localPtr = procPtr->firstLocalPtr; - unsigned int nameLen; - - if (localPtr == NULL) { - goto emptyName; - } - while (index--) { - localPtr = localPtr->nextPtr; - if (localPtr == NULL) { - goto emptyName; - } - } - - nameLen = (unsigned int) localPtr->nameLength; - objPtr->bytes = ckalloc(nameLen + 1); - memcpy(objPtr->bytes, localPtr->name, nameLen + 1); - objPtr->length = nameLen; - return; - - emptyName: - objPtr->bytes = ckalloc(1); - *(objPtr->bytes) = '\0'; - objPtr->length = 0; -} - #if ENABLE_NS_VARNAME_CACHING /* * nsVarName - |