diff options
| -rw-r--r-- | generic/tclBasic.c | 76 | ||||
| -rw-r--r-- | generic/tclCompile.c | 40 | ||||
| -rw-r--r-- | generic/tclCompile.h | 13 | ||||
| -rw-r--r-- | generic/tclExecute.c | 15 | ||||
| -rw-r--r-- | generic/tclInt.h | 24 | ||||
| -rw-r--r-- | generic/tclOOMethod.c | 12 | ||||
| -rw-r--r-- | generic/tclProc.c | 48 | ||||
| -rw-r--r-- | tests/proc.test | 1 |
8 files changed, 66 insertions, 163 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 7202184..d41f38e 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -504,17 +504,12 @@ Tcl_CreateInterp(void) iPtr->varFramePtr = NULL; /* Initialise as soon as :: is available */ /* - * TIP #280 - Initialize the arrays used to extend the ByteCode and Proc - * structures. + * TIP #280 - Initialize the arrays used to track argument locations. */ iPtr->cmdFramePtr = NULL; - iPtr->linePBodyPtr = ckalloc(sizeof(Tcl_HashTable)); - iPtr->lineBCPtr = ckalloc(sizeof(Tcl_HashTable)); iPtr->lineLAPtr = ckalloc(sizeof(Tcl_HashTable)); iPtr->lineLABCPtr = ckalloc(sizeof(Tcl_HashTable)); - Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS); - Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(iPtr->lineLAPtr, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(iPtr->lineLABCPtr, TCL_ONE_WORD_KEYS); iPtr->scriptCLLocPtr = NULL; @@ -1323,7 +1318,6 @@ DeleteInterpProc( Tcl_HashSearch search; Tcl_HashTable *hTablePtr; ResolverScheme *resPtr, *nextResPtr; - int i; /* * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup, @@ -1518,60 +1512,7 @@ DeleteInterpProc( TclDeleteLiteralTable(interp, &iPtr->literalTable); /* - * TIP #280 - Release the arrays for ByteCode/Proc extension, and - * contents. - */ - - for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &search); - hPtr != NULL; - hPtr = Tcl_NextHashEntry(&search)) { - CmdFrame *cfPtr = Tcl_GetHashValue(hPtr); - Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr); - - procPtr->iPtr = NULL; - if (cfPtr) { - if (cfPtr->type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount(cfPtr->data.eval.path); - } - ckfree(cfPtr->line); - ckfree(cfPtr); - } - Tcl_DeleteHashEntry(hPtr); - } - Tcl_DeleteHashTable(iPtr->linePBodyPtr); - ckfree(iPtr->linePBodyPtr); - iPtr->linePBodyPtr = NULL; - - /* - * See also tclCompile.c, TclCleanupByteCode - */ - - for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &search); - hPtr != NULL; - hPtr = Tcl_NextHashEntry(&search)) { - ExtCmdLoc *eclPtr = Tcl_GetHashValue(hPtr); - - if (eclPtr->type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount(eclPtr->path); - } - for (i=0; i< eclPtr->nuloc; i++) { - ckfree(eclPtr->loc[i].line); - } - - if (eclPtr->loc != NULL) { - ckfree(eclPtr->loc); - } - - Tcl_DeleteHashTable(&eclPtr->litInfo); - - ckfree(eclPtr); - Tcl_DeleteHashEntry(hPtr); - } - Tcl_DeleteHashTable(iPtr->lineBCPtr); - ckfree(iPtr->lineBCPtr); - iPtr->lineBCPtr = NULL; - - /* + * TIP #280. * Location stack for uplevel/eval/... scripts which were passed through * proc arguments. Actually we track all arguments as we do not and cannot * know which arguments will be used as scripts and which will not. @@ -5141,19 +5082,20 @@ TclArgumentBCEnter( Tcl_Interp *interp, Tcl_Obj *objv[], int objc, - void *codePtr, + void *codePtr, /* XXX Should be ByteCode*, would invoke cyclic dependency + * XXX on tclCompile.h in tclInt.h + */ CmdFrame *cfPtr, int pc) { Interp *iPtr = (Interp *) interp; - Tcl_HashEntry *hePtr = - Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr); + Tcl_HashEntry* hePtr; ExtCmdLoc *eclPtr; - if (!hePtr) { - return; + eclPtr = ((ByteCode*) codePtr)->loc; + if (!eclPtr) { + return; } - eclPtr = Tcl_GetHashValue(hePtr); hePtr = Tcl_FindHashEntry(&eclPtr->litInfo, INT2PTR(pc)); if (hePtr) { int word; diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 309682d..c2d99ec 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -982,29 +982,24 @@ TclCleanupByteCode( * See also tclBasic.c, DeleteInterpProc */ - if (iPtr) { - Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr, - (char *) codePtr); + if (codePtr->loc) { + ExtCmdLoc *eclPtr = codePtr->loc; - if (hePtr) { - ExtCmdLoc *eclPtr = Tcl_GetHashValue(hePtr); - - if (eclPtr->type == TCL_LOCATION_SOURCE) { - Tcl_DecrRefCount(eclPtr->path); - } - for (i=0 ; i<eclPtr->nuloc ; i++) { - ckfree(eclPtr->loc[i].line); - } - - if (eclPtr->loc != NULL) { - ckfree(eclPtr->loc); - } + if (eclPtr->type == TCL_LOCATION_SOURCE) { + Tcl_DecrRefCount(eclPtr->path); + } + for (i=0 ; i<eclPtr->nuloc ; i++) { + ckfree(eclPtr->loc[i].line); + } + + if (eclPtr->loc != NULL) { + ckfree(eclPtr->loc); + } - Tcl_DeleteHashTable(&eclPtr->litInfo); + Tcl_DeleteHashTable(&eclPtr->litInfo); - ckfree(eclPtr); - Tcl_DeleteHashEntry(hePtr); - } + ckfree(eclPtr); + codePtr->loc = 0; } if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) { @@ -2506,7 +2501,7 @@ TclInitByteCodeObj( #endif int numLitObjects = envPtr->literalArrayNext; Namespace *namespacePtr; - int i, isNew; + int i; Interp *iPtr; iPtr = envPtr->iPtr; @@ -2642,8 +2637,7 @@ TclInitByteCodeObj( * byte code object (internal rep), for use with the bc compiler. */ - Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->lineBCPtr, codePtr, - &isNew), envPtr->extCmdMapPtr); + codePtr->loc = envPtr->extCmdMapPtr; envPtr->extCmdMapPtr = NULL; codePtr->localCachePtr = NULL; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 3302f9b..e6350f3 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -119,10 +119,9 @@ typedef struct CmdLocation { * Structure to record additional location information for byte code. This * information is internal and not saved. i.e. tbcload'ed code will not have * this information. It records the lines for all words of all commands found - * in the byte code. The association with a ByteCode structure BC is done - * through the 'lineBCPtr' HashTable in Interp, keyed by the address of BC. - * Also recorded is information coming from the context, i.e. type of the - * frame and associated information, like the path of a sourced file. + * in the byte code. See the ByteCode->loc field. Also recorded is information + * coming from the context, i.e. type of the frame and associated information, + * like the path of a sourced file. */ typedef struct ECL { @@ -131,8 +130,7 @@ typedef struct ECL { int *line; /* Line information for all words in the * command. */ int **next; /* Transient information used by the compiler - * for tracking of hidden continuation - * lines. */ + * to track hidden continuation lines. */ } ECL; typedef struct ExtCmdLoc { @@ -441,6 +439,9 @@ typedef struct ByteCode { LocalCache *localCachePtr; /* Pointer to the start of the cached variable * names and initialisation data for local * variables. */ + + struct ExtCmdLoc* loc; /* #280 location data */ + #ifdef TCL_COMPILE_STATS Tcl_Time createTime; /* Absolute time when the ByteCode was * created. */ diff --git a/generic/tclExecute.c b/generic/tclExecute.c index cb1864c40..9ab7054 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -1640,17 +1640,14 @@ TclCompileObj( if (invoker == NULL) { return codePtr; } else { - Tcl_HashEntry *hePtr = - Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr); - ExtCmdLoc *eclPtr; + ExtCmdLoc *eclPtr = codePtr->loc; CmdFrame *ctxCopyPtr; int redo; - if (!hePtr) { + if (!eclPtr) { return codePtr; } - eclPtr = Tcl_GetHashValue(hePtr); redo = 0; ctxCopyPtr = TclStackAlloc(interp, sizeof(CmdFrame)); *ctxCopyPtr = *invoker; @@ -8505,19 +8502,15 @@ TclGetSrcInfoForPc( * there find the list of word locations for this command. */ - ExtCmdLoc *eclPtr; + ExtCmdLoc *eclPtr = codePtr->loc; ECL *locPtr = NULL; int srcOffset, i; - Interp *iPtr = (Interp *) *codePtr->interpHandle; - Tcl_HashEntry *hePtr = - Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr); - if (!hePtr) { + if (!eclPtr) { return; } srcOffset = cfPtr->cmd.str.cmd - codePtr->source; - eclPtr = Tcl_GetHashValue(hePtr); for (i=0; i < eclPtr->nuloc; i++) { if (eclPtr->loc[i].srcOffset == srcOffset) { diff --git a/generic/tclInt.h b/generic/tclInt.h index 0efb1b6..f88c53f 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -969,6 +969,8 @@ typedef struct CompiledLocal { * variables recognized at compile time. */ +struct CmdFrame; /* Forward declaration for Proc. */ + typedef struct Proc { struct Interp *iPtr; /* Interpreter for which this command is * defined. */ @@ -996,6 +998,8 @@ typedef struct Proc { CompiledLocal *lastLocalPtr;/* Pointer to the last allocated local * variable or NULL if none. This has frame * index (numCompiledLocals-1). */ + + struct CmdFrame* loc; /* #280 location data */ } Proc; /* @@ -1251,7 +1255,7 @@ typedef struct CmdFrame { * was pushed. */ const struct CFWordBC *litarg; /* Link to set of literal arguments which have - * ben pushed on the lineLABCPtr stack by + * been pushed on the lineLABCPtr stack by * TclArgumentBCEnter(). These will be removed * by TclArgumentBCRelease. */ } CmdFrame; @@ -2033,17 +2037,10 @@ typedef struct Interp { * active. */ int invokeWord; /* Index of the word in the command which * is getting compiled. */ - Tcl_HashTable *linePBodyPtr;/* This table remembers for each statically - * defined procedure the location information - * for its body. It is keyed by the address of - * the Proc structure for a procedure. The - * values are "struct CmdFrame*". */ - Tcl_HashTable *lineBCPtr; /* This table remembers for each ByteCode - * object the location information for its - * body. It is keyed by the address of the - * Proc structure for a procedure. The values - * are "struct ExtCmdLoc*". (See - * tclCompile.h) */ + + /* XXX: Adding the line information to Tcl_Obj will blow up the memory used by the system. + * XXX: But might be faster. Any other way getting both? + */ Tcl_HashTable *lineLABCPtr; Tcl_HashTable *lineLAPtr; /* This table remembers for each argument of a * command on the execution stack the index of @@ -2856,6 +2853,9 @@ MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp, MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int objc, void *codePtr, CmdFrame *cfPtr, int pc); +/* XXX (void* codePtr) breaks cyclic dependency on tclCompile.h. + * XXX Proper type is (ByteCode* codePtr) + */ MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, CmdFrame *cfPtr); MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj, diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 28820e0..e84e04f 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -498,9 +498,7 @@ TclOOMakeProcInstanceMethod( if (context.line && (context.nline >= 4) && (context.line[3] >= 0)) { - int isNew; CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame)); - Tcl_HashEntry *hPtr; cfPtr->level = -1; cfPtr->type = context.type; @@ -516,9 +514,7 @@ TclOOMakeProcInstanceMethod( cfPtr->cmd.str.cmd = NULL; cfPtr->cmd.str.len = 0; - hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr, - (char *) procPtr, &isNew); - Tcl_SetHashValue(hPtr, cfPtr); + procPtr->loc = cfPtr; } /* @@ -611,9 +607,7 @@ TclOOMakeProcMethod( if (context.line && (context.nline >= 4) && (context.line[3] >= 0)) { - int isNew; CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame)); - Tcl_HashEntry *hPtr; cfPtr->level = -1; cfPtr->type = context.type; @@ -629,9 +623,7 @@ TclOOMakeProcMethod( cfPtr->cmd.str.cmd = NULL; cfPtr->cmd.str.len = 0; - hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr, - (char *) procPtr, &isNew); - Tcl_SetHashValue(hPtr, cfPtr); + procPtr->loc = cfPtr; } /* diff --git a/generic/tclProc.c b/generic/tclProc.c index 933e7d2..8c79396 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -256,8 +256,6 @@ Tcl_ProcObjCmd( if (contextPtr->line && (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) { - int isNew; - Tcl_HashEntry *hePtr; CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame)); cfPtr->level = -1; @@ -274,9 +272,7 @@ Tcl_ProcObjCmd( cfPtr->cmd.str.cmd = NULL; cfPtr->cmd.str.len = 0; - hePtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr, - procPtr, &isNew); - if (!isNew) { + if (procPtr->loc) { /* * Get the old command frame and release it. See also * TclProcCleanupProc in this file. Currently it seems as @@ -284,8 +280,7 @@ Tcl_ProcObjCmd( * is able to trigger this situation. */ - CmdFrame *cfOldPtr = Tcl_GetHashValue(hePtr); - + CmdFrame *cfOldPtr = procPtr->loc; if (cfOldPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(cfOldPtr->data.eval.path); cfOldPtr->data.eval.path = NULL; @@ -294,7 +289,7 @@ Tcl_ProcObjCmd( cfOldPtr->line = NULL; ckfree(cfOldPtr); } - Tcl_SetHashValue(hePtr, cfPtr); + procPtr->loc = cfPtr; } /* @@ -472,6 +467,7 @@ TclCreateProc( procPtr->numCompiledLocals = 0; procPtr->firstLocalPtr = NULL; procPtr->lastLocalPtr = NULL; + procPtr->loc = 0; } /* @@ -2015,8 +2011,6 @@ TclProcCompileProc( } if (bodyPtr->typePtr != &tclByteCodeType) { - Tcl_HashEntry *hePtr; - #ifdef TCL_COMPILE_DEBUG if (tclTraceCompile >= 1) { /* @@ -2084,17 +2078,15 @@ TclProcCompileProc( /* * TIP #280: We get the invoking context from the cmdFrame which - * was saved by 'Tcl_ProcObjCmd' (using linePBodyPtr). + * was saved by 'Tcl_ProcObjCmd' */ - hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr); - /* * Constructed saved frame has body as word 0. See Tcl_ProcObjCmd. */ iPtr->invokeWord = 0; - iPtr->invokeCmdFramePtr = (hePtr ? Tcl_GetHashValue(hePtr) : NULL); + iPtr->invokeCmdFramePtr = (procPtr->loc ? procPtr->loc : NULL); tclByteCodeType.setFromAnyProc(interp, bodyPtr); iPtr->invokeCmdFramePtr = NULL; TclPopStackFrame(interp); @@ -2202,9 +2194,7 @@ TclProcCleanupProc( Tcl_Obj *bodyPtr = procPtr->bodyPtr; Tcl_Obj *defPtr; Tcl_ResolvedVarInfo *resVarInfo; - Tcl_HashEntry *hePtr = NULL; CmdFrame *cfPtr = NULL; - Interp *iPtr = procPtr->iPtr; if (bodyPtr != NULL) { Tcl_DecrRefCount(bodyPtr); @@ -2228,25 +2218,14 @@ TclProcCleanupProc( ckfree(localPtr); localPtr = nextPtr; } - ckfree(procPtr); /* * TIP #280: Release the location data associated with this Proc - * structure, if any. The interpreter may not exist (For example for - * procbody structures created by tbcload. + * structure, if any. The data may not exist (For example for procbody + * structures created by tbcload. */ - if (iPtr == NULL) { - return; - } - - hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr); - if (!hePtr) { - return; - } - - cfPtr = Tcl_GetHashValue(hePtr); - + cfPtr = procPtr->loc; if (cfPtr) { if (cfPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(cfPtr->data.eval.path); @@ -2256,7 +2235,8 @@ TclProcCleanupProc( cfPtr->line = NULL; ckfree(cfPtr); } - Tcl_DeleteHashEntry(hePtr); + + ckfree(procPtr); } /* @@ -2487,7 +2467,7 @@ SetLambdaFromAny( Interp *iPtr = (Interp *) interp; const char *name; Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv; - int isNew, objc, result; + int objc, result; CmdFrame *cfPtr = NULL; Proc *procPtr; @@ -2617,8 +2597,8 @@ SetLambdaFromAny( } TclStackFree(interp, contextPtr); } - Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, procPtr, - &isNew), cfPtr); + + procPtr->loc = cfPtr; /* * Set the namespace for this lambda: given by objv[2] understood as a diff --git a/tests/proc.test b/tests/proc.test index e06720e..97f4ab0 100644 --- a/tests/proc.test +++ b/tests/proc.test @@ -308,6 +308,7 @@ test proc-4.8 {TclCreateProc, procbody obj, no leak on multiple iterations} -set set tmp $end set end [getbytes] } + memory active a-$i set leakedBytes [expr {$end - $tmp}] } -cleanup { rename getbytes {} |