diff options
| -rw-r--r-- | ChangeLog | 11 | ||||
| -rw-r--r-- | generic/tclBasic.c | 136 | ||||
| -rw-r--r-- | generic/tclCompile.c | 43 | ||||
| -rw-r--r-- | generic/tclCompile.h | 11 | ||||
| -rw-r--r-- | generic/tclExecute.c | 6 | ||||
| -rw-r--r-- | generic/tclInt.h | 20 |
6 files changed, 167 insertions, 60 deletions
@@ -1,3 +1,14 @@ +2008-07-22 Andreas Kupries <andreask@activestate.com> + + * generic/tclBasic.c: Reworked the handling of bytecode literals + * generic/tclCompile.c: for #280 to fix the abysmal performance + * generic/tclCompile.h: for deep recursion, replaced the linear + * generic/tclExecute.c: search through the whole stack with + * generic/tclInt.h: another hashtable and simplified the data + structure used by the compiler (array instead of hashtable). + Incidentially this also fixes the memory leak reported via [Bug + 2024937]. + 2008-07-21 Don Porter <dgp@users.sourceforge.net> * tests/encoding.test: Make failing tests pass again. [Bug 1972867] diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 8c1fe40..f2e4fc6 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.295.2.1 2008/07/21 19:38:13 andreas_kupries Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.295.2.2 2008/07/22 21:41:11 andreas_kupries Exp $ */ #include "tclInt.h" @@ -445,9 +445,11 @@ Tcl_CreateInterp(void) iPtr->linePBodyPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); iPtr->lineBCPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable)); iPtr->lineLAPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable)); + iPtr->lineLABCPtr = (Tcl_HashTable*) 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->activeVarTracePtr = NULL; @@ -1433,6 +1435,19 @@ DeleteInterpProc( Tcl_DeleteHashTable (iPtr->lineLAPtr); ckfree((char*) iPtr->lineLAPtr); iPtr->lineLAPtr = NULL; + + if (iPtr->lineLABCPtr->numEntries) { + /* + * When the interp goes away we have nothing on the stack, so + * there are no arguments, so this table has to be empty. + */ + + Tcl_Panic ("Argument location tracking table not empty"); + } + + Tcl_DeleteHashTable (iPtr->lineLABCPtr); + ckfree((char*) iPtr->lineLABCPtr); + iPtr->lineLABCPtr = NULL; } Tcl_DeleteHashTable(&iPtr->varTraces); @@ -4586,6 +4601,80 @@ TclArgumentRelease(interp,objv,objc) } } +void +TclArgumentBCEnter(interp,codePtr,cfPtr) + Tcl_Interp* interp; + void* codePtr; + CmdFrame* cfPtr; +{ + Interp* iPtr = (Interp*) interp; + Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->lineBCPtr, (char *) codePtr); + + if (hePtr) { + ExtCmdLoc* eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr); + int i; + + for (i=0; i < eclPtr->nueiloc; i++) { + + ExtIndex* eiPtr = &eclPtr->eiloc[i]; + Tcl_Obj* obj = eiPtr->obj; + int new; + Tcl_HashEntry* hPtr; + CFWordBC* cfwPtr; + + hPtr = Tcl_CreateHashEntry (iPtr->lineLABCPtr, (char*) obj, &new); + if (new) { + /* + * The word is not on the stack yet, remember the current location + * and initialize references. + */ + cfwPtr = (CFWordBC*) ckalloc (sizeof (CFWordBC)); + cfwPtr->framePtr = cfPtr; + cfwPtr->eiPtr = eiPtr; + cfwPtr->refCount = 1; + Tcl_SetHashValue (hPtr, cfwPtr); + } else { + /* + * The word is already on the stack, its current location is not + * relevant. Just remember the reference to prevent early removal. + */ + cfwPtr = (CFWordBC*) Tcl_GetHashValue (hPtr); + cfwPtr->refCount ++; + } + } /* for */ + } /* if */ +} + +void +TclArgumentBCRelease(interp,codePtr) + Tcl_Interp* interp; + void* codePtr; +{ + Interp* iPtr = (Interp*) interp; + Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->lineBCPtr, (char *) codePtr); + + if (hePtr) { + ExtCmdLoc* eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr); + int i; + + for (i=0; i < eclPtr->nueiloc; i++) { + Tcl_Obj* obj = eclPtr->eiloc[i].obj; + Tcl_HashEntry* hPtr = Tcl_FindHashEntry (iPtr->lineLABCPtr, (char *) obj); + CFWordBC* cfwPtr; + + if (!hPtr) { continue; } + + cfwPtr = (CFWordBC*) Tcl_GetHashValue (hPtr); + + cfwPtr->refCount --; + if (cfwPtr->refCount > 0) { continue; } + + ckfree ((char*) cfwPtr); + Tcl_DeleteHashEntry (hPtr); + } /* for */ + } /* if */ +} + /* *---------------------------------------------------------------------- * @@ -4629,43 +4718,20 @@ TclArgumentGet(interp,obj,cfPtrPtr,wordPtr) } /* - * Check if the Tcl_Obj has location information as a bytecode literal. We - * have to scan the stack up and check all bytecode frames for a possible - * definition. + * Check if the Tcl_Obj has location information as a bytecode literal, in + * that stack. */ - for (framePtr = iPtr->cmdFramePtr; - framePtr; - framePtr = framePtr->nextPtr) { - const ByteCode* codePtr; - Tcl_HashEntry* hePtr; - - if (framePtr->type != TCL_LOCATION_BC) continue; - - codePtr = framePtr->data.tebc.codePtr; - hePtr = Tcl_FindHashEntry (iPtr->lineBCPtr, (char *) codePtr); - - if (hePtr) { - ExtCmdLoc* eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr); - Tcl_HashEntry *hlPtr = Tcl_FindHashEntry (&eclPtr->litIndex, (char *) obj); - - if (hlPtr) { - /* - * Convert from the current invoker CmdFrame to a CmdFrame - * refering to the actual word location. We are directly - * manipulating the relevant command frame in the frame stack. - * That is no problem because TEBC is already setting the pc - * for each invokation, so moving it somewhere will not affect - * the following commands. - */ - - ExtIndex* eiPtr = (ExtIndex*) Tcl_GetHashValue (hlPtr); + hPtr = Tcl_FindHashEntry (iPtr->lineLABCPtr, (char *) obj); + if (hPtr) { + CFWordBC* cfwPtr = (CFWordBC*) Tcl_GetHashValue (hPtr); + ExtIndex* eiPtr = cfwPtr->eiPtr; - framePtr->data.tebc.pc = codePtr->codeStart + eiPtr->pc; - *cfPtrPtr = framePtr; - *wordPtr = eiPtr->word; - } - } + framePtr = cfwPtr->framePtr; + framePtr->data.tebc.pc = ((ByteCode*) framePtr->data.tebc.codePtr)->codeStart + eiPtr->pc; + *cfPtrPtr = cfwPtr->framePtr; + *wordPtr = eiPtr->word; + return; } } diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 145a7b9..19011d9 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -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: tclCompile.c,v 1.146.2.2 2008/07/21 19:38:17 andreas_kupries Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.146.2.3 2008/07/22 21:41:12 andreas_kupries Exp $ */ #include "tclInt.h" @@ -802,8 +802,6 @@ TclCleanupByteCode( if (hePtr) { ExtCmdLoc *eclPtr = Tcl_GetHashValue(hePtr); int i; - Tcl_HashSearch hSearch; - Tcl_HashEntry *hlPtr; if (eclPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(eclPtr->path); @@ -817,14 +815,10 @@ TclCleanupByteCode( } /* Release index of literals as well. */ - for (hlPtr = Tcl_FirstHashEntry(&eclPtr->litIndex, &hSearch); - hlPtr != NULL; - hlPtr = Tcl_NextHashEntry(&hSearch)) { - ExtIndex* eiPtr = (ExtIndex*) Tcl_GetHashValue (hlPtr); - ckfree((char*) eiPtr); - Tcl_DeleteHashEntry (hlPtr); + if (eclPtr->eiloc != NULL) { + ckfree((char *) eclPtr->eiloc); } - Tcl_DeleteHashTable (&eclPtr->litIndex); + ckfree((char *) eclPtr); Tcl_DeleteHashEntry(hePtr); } @@ -914,7 +908,9 @@ TclInitCompileEnv( envPtr->extCmdMapPtr->nloc = 0; envPtr->extCmdMapPtr->nuloc = 0; envPtr->extCmdMapPtr->path = NULL; - Tcl_InitHashTable(&envPtr->extCmdMapPtr->litIndex, TCL_ONE_WORD_KEYS); + envPtr->extCmdMapPtr->eiloc = NULL; + envPtr->extCmdMapPtr->neiloc = 0; + envPtr->extCmdMapPtr->nueiloc = 0; if (invoker == NULL) { /* @@ -2446,15 +2442,30 @@ TclEnterCmdWordIndex (eclPtr, obj, pc, word) int pc; int word; { - int new; - ExtIndex* eiPtr = (ExtIndex*) ckalloc (sizeof (ExtIndex)); + ExtIndex* eiPtr; + + if (eclPtr->nueiloc >= eclPtr->neiloc) { + /* + * Expand the ExtIndex array by allocating more storage from the heap. The + * currently allocated ECL entries are stored from eclPtr->loc[0] up + * to eclPtr->loc[eclPtr->nuloc-1] (inclusive). + */ + + size_t currElems = eclPtr->neiloc; + size_t newElems = (currElems ? 2*currElems : 1); + size_t newBytes = newElems * sizeof(ExtIndex); + + eclPtr->eiloc = (ExtIndex *) ckrealloc((char *)(eclPtr->eiloc), newBytes); + eclPtr->neiloc = newElems; + } + + eiPtr = &eclPtr->eiloc[eclPtr->nueiloc]; + eiPtr->obj = obj; eiPtr->pc = pc; eiPtr->word = word; - Tcl_SetHashValue (Tcl_CreateHashEntry (&eclPtr->litIndex, - (char*) obj, &new), - eiPtr); + eclPtr->nueiloc ++; } /* diff --git a/generic/tclCompile.h b/generic/tclCompile.h index f1be02c..e5ef895 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -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: tclCompile.h,v 1.90.2.1 2008/07/21 19:38:18 andreas_kupries Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.90.2.2 2008/07/22 21:41:12 andreas_kupries Exp $ */ #ifndef _TCLCOMPILATION @@ -141,14 +141,11 @@ typedef struct ExtCmdLoc { ECL *loc; /* Command word locations (lines). */ int nloc; /* Number of allocated entries in 'loc'. */ int nuloc; /* Number of used entries in 'loc'. */ - Tcl_HashTable litIndex; /* HashValue is ExtIndex* */ + ExtIndex* eiloc; + int neiloc; + int nueiloc; } ExtCmdLoc; -typedef struct ExtIndex { - int pc; /* Instruction pointer of a command in ExtCmdLoc.loc[.] */ - int word; /* Index of word in ExtCmdLoc.loc[cmd]->line[.] */ -} ExtIndex; - EXTERN void TclEnterCmdWordIndex (ExtCmdLoc *eclPtr, Tcl_Obj* obj, int pc, int word); diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 0003fb2..7866a7c 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.369.2.1 2008/04/08 16:12:02 dgp Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.369.2.2 2008/07/22 21:41:13 andreas_kupries Exp $ */ #include "tclInt.h" @@ -1753,6 +1753,8 @@ TclExecuteByteCode( bcFramePtr->cmd.str.cmd = NULL; bcFramePtr->cmd.str.len = 0; + TclArgumentBCEnter((Tcl_Interp*) iPtr,codePtr,bcFramePtr); + #ifdef TCL_COMPILE_DEBUG if (tclTraceExec >= 2) { PrintByteCodeInfo(codePtr); @@ -7389,6 +7391,8 @@ TclExecuteByteCode( } } + TclArgumentBCRelease((Tcl_Interp*) iPtr,codePtr); + /* * Restore the stack to the state it had previous to this bytecode. */ diff --git a/generic/tclInt.h b/generic/tclInt.h index e0e65e4..bbbdf2f 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.362.2.2 2008/07/21 19:38:18 andreas_kupries Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.362.2.3 2008/07/22 21:41:13 andreas_kupries Exp $ */ #ifndef _TCLINT @@ -1147,6 +1147,19 @@ typedef struct CFWord { int refCount; /* #times the word is on the stack */ } CFWord; +typedef struct ExtIndex { + Tcl_Obj* obj; /* Reference to the word */ + int pc; /* Instruction pointer of a command in ExtCmdLoc.loc[.] */ + int word; /* Index of word in ExtCmdLoc.loc[cmd]->line[.] */ +} ExtIndex; + + +typedef struct CFWordBC { + CmdFrame* framePtr; /* CmdFrame to acess */ + ExtIndex* eiPtr; /* Word info: PC and index */ + int refCount; /* #times the word is on the stack */ +} CFWordBC; + /* * The following macros define the allowed values for the type field of the * CmdFrame structure above. Some of the values occur only in the extended @@ -1845,6 +1858,7 @@ typedef struct Interp { * body. It is keyed by the address of the * Proc structure for a procedure. The values * are "struct ExtCmdLoc*" (See tclCompile.h) */ + Tcl_HashTable* lineLABCPtr; Tcl_HashTable* lineLAPtr; /* This table remembers for each argument of a * command on the execution stack the index of * the argument in the command, and the @@ -2457,6 +2471,10 @@ MODULE_SCOPE void TclArgumentRelease(Tcl_Interp* interp, Tcl_Obj* objv[], int objc); MODULE_SCOPE void TclArgumentGet(Tcl_Interp* interp, Tcl_Obj* obj, CmdFrame** cfPtrPtr, int* wordPtr); +MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp* interp, + void* codePtr, CmdFrame* cfPtr); +MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp* interp, + void* codePtr); MODULE_SCOPE int TclArraySet(Tcl_Interp *interp, Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj); MODULE_SCOPE double TclBignumToDouble(mp_int *bignum); |