diff options
author | andreas_kupries <andreas_kupries@noemail.net> | 2008-07-22 21:40:03 (GMT) |
---|---|---|
committer | andreas_kupries <andreas_kupries@noemail.net> | 2008-07-22 21:40:03 (GMT) |
commit | eceb74403fd6dd050eb27e21cd522dabec64c9be (patch) | |
tree | cef9d19da7d093c66b64a11ba40714de761a2840 /generic/tclBasic.c | |
parent | f76d914a0e1b9ed36c306b9311e03c1d517040e4 (diff) | |
download | tcl-eceb74403fd6dd050eb27e21cd522dabec64c9be.zip tcl-eceb74403fd6dd050eb27e21cd522dabec64c9be.tar.gz tcl-eceb74403fd6dd050eb27e21cd522dabec64c9be.tar.bz2 |
* 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].
FossilOrigin-Name: bb509fe952436dae5b069f624b2029dcc0777f80
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r-- | generic/tclBasic.c | 137 |
1 files changed, 102 insertions, 35 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 4ad59c7..6ec5763 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.75.2.29 2008/07/21 19:37:40 andreas_kupries Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.75.2.30 2008/07/22 21:40:24 andreas_kupries Exp $ */ #include "tclInt.h" @@ -361,9 +361,11 @@ Tcl_CreateInterp() 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); #endif iPtr->activeVarTracePtr = NULL; @@ -1226,6 +1228,19 @@ DeleteInterpProc(interp) 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; } #endif ckfree((char *) iPtr); @@ -4413,7 +4428,82 @@ TclArgumentRelease(interp,objv,objc) Tcl_DeleteHashEntry (hPtr); } } + + +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 */ +} + /* *---------------------------------------------------------------------- * @@ -4457,43 +4547,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; } } #endif |