summaryrefslogtreecommitdiffstats
path: root/generic/tclBasic.c
diff options
context:
space:
mode:
authorandreas_kupries <akupries@shaw.ca>2009-07-14 16:34:08 (GMT)
committerandreas_kupries <akupries@shaw.ca>2009-07-14 16:34:08 (GMT)
commit08604cad04da0d67c84406f99bda814f6a416386 (patch)
tree96331345b305a3ee61ad9c1dfa7f37983ab71540 /generic/tclBasic.c
parent02457f7d6507f76fac8b308899e6592ab8214cb3 (diff)
downloadtcl-08604cad04da0d67c84406f99bda814f6a416386.zip
tcl-08604cad04da0d67c84406f99bda814f6a416386.tar.gz
tcl-08604cad04da0d67c84406f99bda814f6a416386.tar.bz2
* generic/tclCompile.c (TclInitCompileEnv, EnterCmdWordIndex,
TclCleanupByteCode, TclCompileScript): * generic/tclExecute.c (TclCompileObj, TclExecuteByteCode): * tclCompile.h (ExtCmdLoc): * tclInt.h (ExtIndex, CFWordBC, CmdFrame): * tclBasic.c (DeleteInterpProc, TclArgumentBCEnter, TclArgumentBCRelease, TclArgumentGet, SAVE_CONTEXT, RESTORE_CONTEXT, NRCoroutineExitCallback, TclNRCoroutineObjCmd): * generic/tclCmdAH.c (TclNRForObjCmd, TclNRForIterCallback, ForNextCallback): * generic/tclCmdMZ.c (TclNRWhileObjCmd): Extended the bytecode compiler initialization to recognize the compilation of whole files (NRE enabled 'source' command) and switch to the counting of absolute lines in that case. Further extended the bytecode compiler to track the start line in the generated information, and modified the bytecode execution to recompile an object if the location as per the calling context doesn't match the location saved in the bytecode. This part could be optimized more by using more memory to keep all possibilities which occur around, or by just adjusting the location information instead of a total recompile. Reworked the handling of literal command arguments in bytecode to be saved (compiler) and used (execution) per command (See the TCL_INVOKE_STK* instructions), and not per the whole bytecode. This, and the previous change remove the problems with location data caused by literal sharing (across whole files, but also proc bodies). Simplified the associated datastructures (ExtIndex is gone, as is the function EnterCmdWordIndex). The last change causes the hashtable 'lineLABCPtr' to be state which has to be kept per coroutine, like the CmdFrame stack. Reworked the coroutine support code to create, delete and switch the information as needed. Further reworked the tailcall command as well, it has to pop its own arguments when run in a bytecode context to keep a proper stack in 'lineLABCPtr'. Fixed the mishandling of line information in the NRE-enabled 'for' and 'while' commands introduced when both were made to share their iteration callbacks without taking into account that the loop body is found in different words of the command. Introduced a separate data structure to hold all the callback information, as we went over the limit of 4 direct client-data values for NRE callbacks. The above fixes [Bug 1605269].
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r--generic/tclBasic.c220
1 files changed, 150 insertions, 70 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 264fdc8..a097976 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -16,7 +16,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.394 2009/05/08 08:48:19 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.395 2009/07/14 16:34:08 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -1545,9 +1545,7 @@ DeleteInterpProc(
ckfree((char *) eclPtr->loc);
}
- if (eclPtr->eiloc != NULL) {
- ckfree((char *) eclPtr->eiloc);
- }
+ Tcl_DeleteHashTable (&eclPtr->litInfo);
ckfree((char *) eclPtr);
Tcl_DeleteHashEntry(hPtr);
@@ -5448,49 +5446,74 @@ TclArgumentRelease(
void
TclArgumentBCEnter(
- Tcl_Interp *interp,
- void *codePtr,
- CmdFrame *cfPtr)
+ Tcl_Interp* interp,
+ Tcl_Obj* objv[],
+ int objc,
+ void* codePtr,
+ CmdFrame* cfPtr,
+ int pc)
{
- Interp *iPtr = (Interp *) interp;
- Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr,
- (char *) codePtr);
+ Interp* iPtr = (Interp*) interp;
+ Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->lineBCPtr, (char *) codePtr);
if (hePtr) {
- ExtCmdLoc *eclPtr = Tcl_GetHashValue(hePtr);
- int i;
+ ExtCmdLoc* eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr);
+ hePtr = Tcl_FindHashEntry(&eclPtr->litInfo, (char*) pc);
- for (i = 0; i < eclPtr->nueiloc; i++) {
- ExtIndex *eiPtr = &eclPtr->eiloc[i];
- Tcl_Obj *obj = eiPtr->obj;
- int new;
- Tcl_HashEntry *hPtr;
- CFWordBC *cfwPtr;
+ if (hePtr) {
+ int word;
+ int cmd = (int) Tcl_GetHashValue(hePtr);
+ ECL* ePtr = &eclPtr->loc[cmd];
+ CFWordBC* lastPtr = 0;
- 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.
- */
+ /*
+ * A few truths ...
+ * (1) ePtr->nline == objc
+ * (2) (ePtr->line[word] < 0) => !literal, for all words
+ * (3) (word == 0) => !literal
+ *
+ * Item (2) is why we can use objv to get the literals, and do not
+ * have to save them at compile time.
+ */
- 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.
- */
+ for (word = 1; word < objc; word++) {
+ if (ePtr->line[word] >= 0) {
+ int isnew;
+ Tcl_HashEntry* hPtr =
+ Tcl_CreateHashEntry (iPtr->lineLABCPtr,
+ (char*) objv[word], &isnew);
+ CFWordBC* cfwPtr = (CFWordBC*) ckalloc (sizeof (CFWordBC));
+
+ cfwPtr->framePtr = cfPtr;
+ cfwPtr->obj = objv[word];
+ cfwPtr->pc = pc;
+ cfwPtr->word = word;
+ cfwPtr->nextPtr = lastPtr;
+ lastPtr = cfwPtr;
+
+ if (isnew) {
+ /*
+ * The word is not on the stack yet, remember the
+ * current location and initialize references.
+ */
+ cfwPtr->prevPtr = NULL;
+ } else {
+ /*
+ * The object is already on the stack, however it may
+ * have a different location now (literal sharing may
+ * map multiple location to a single Tcl_Obj*. Save
+ * the old information in the new structure.
+ */
+ cfwPtr->prevPtr = (CFWordBC*) Tcl_GetHashValue(hPtr);
+ }
- cfwPtr = Tcl_GetHashValue(hPtr);
- cfwPtr->refCount++;
- }
- }
- }
+ Tcl_SetHashValue (hPtr, cfwPtr);
+ }
+ } /* for */
+
+ cfPtr->litarg = lastPtr;
+ } /* if */
+ } /* if */
}
/*
@@ -5516,37 +5539,33 @@ TclArgumentBCEnter(
void
TclArgumentBCRelease(
Tcl_Interp *interp,
- void *codePtr)
+ CmdFrame* cfPtr)
{
- Interp *iPtr = (Interp *) interp;
- Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr,
- (char *) codePtr);
+ Interp* iPtr = (Interp*) interp;
+ CFWordBC* cfwPtr = (CFWordBC*) cfPtr->litarg;
- if (hePtr) {
- ExtCmdLoc *eclPtr = 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 = Tcl_GetHashValue(hPtr);
+ while (cfwPtr) {
+ CFWordBC* nextPtr = cfwPtr->nextPtr;
+ Tcl_HashEntry* hPtr =
+ Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) cfwPtr->obj);
+ CFWordBC* xPtr = (CFWordBC*) Tcl_GetHashValue (hPtr);
- cfwPtr->refCount--;
- if (cfwPtr->refCount > 0) {
- continue;
- }
+ if (xPtr != cfwPtr) {
+ Tcl_Panic ("TclArgumentBC Enter/Release Mismatch");
+ }
- ckfree((char *) cfwPtr);
+ if (cfwPtr->prevPtr) {
+ Tcl_SetHashValue(hPtr, cfwPtr->prevPtr);
+ } else {
Tcl_DeleteHashEntry(hPtr);
}
+
+ ckfree((char *) cfwPtr);
+
+ cfwPtr = nextPtr;
}
+
+ cfPtr->litarg = NULL;
}
/*
@@ -5612,13 +5631,12 @@ TclArgumentGet(
hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) obj);
if (hPtr) {
CFWordBC *cfwPtr = Tcl_GetHashValue(hPtr);
- ExtIndex *eiPtr = cfwPtr->eiPtr;
framePtr = cfwPtr->framePtr;
framePtr->data.tebc.pc = (char *) (((ByteCode *)
- framePtr->data.tebc.codePtr)->codeStart + eiPtr->pc);
+ framePtr->data.tebc.codePtr)->codeStart + cfwPtr->pc);
*cfPtrPtr = cfwPtr->framePtr;
- *wordPtr = eiPtr->word;
+ *wordPtr = cfwPtr->word;
return;
}
}
@@ -8072,6 +8090,16 @@ TclNRTailcallObjCmd(
* TclNRAddCallBack macro to build the callback)
*/
+ /*
+ * In a bytecode execution context the engine has called
+ * TclArgumentBCEnter() which, due to the tailcall, is not paired with a
+ * regular TclArgumentBCRelease. Get rid of it on our own.
+ */
+
+ if (iPtr->cmdFramePtr->type == TCL_LOCATION_BC) {
+ TclArgumentBCRelease (interp, iPtr->cmdFramePtr);
+ }
+
TclNRAddCallback(interp, NRTailcallEval, listPtr, nsObjPtr, NULL, NULL);
tailcallPtr = TOP_CB(interp);
TOP_CB(interp) = tailcallPtr->nextPtr;
@@ -8182,12 +8210,14 @@ static const CorContext NULL_CONTEXT = {NULL, NULL, NULL};
#define SAVE_CONTEXT(context) \
(context).framePtr = iPtr->framePtr; \
(context).varFramePtr = iPtr->varFramePtr; \
- (context).cmdFramePtr = iPtr->cmdFramePtr
+ (context).cmdFramePtr = iPtr->cmdFramePtr; \
+ (context).lineLABCPtr = iPtr->lineLABCPtr
#define RESTORE_CONTEXT(context) \
iPtr->framePtr = (context).framePtr; \
iPtr->varFramePtr = (context).varFramePtr; \
- iPtr->cmdFramePtr = (context).cmdFramePtr
+ iPtr->cmdFramePtr = (context).cmdFramePtr; \
+ iPtr->lineLABCPtr = (context).lineLABCPtr
#define iPtr ((Interp *) interp)
@@ -8384,7 +8414,8 @@ NRCoroutineExitCallback(
TclDeleteExecEnv(corPtr->eePtr);
corPtr->eePtr = NULL;
- /* RESTORE_CONTEXT(corPtr->caller); AUTOMATIC! */
+ SAVE_CONTEXT(corPtr->running);
+ RESTORE_CONTEXT(corPtr->caller);
NRE_ASSERT(iPtr->framePtr == corPtr->caller.framePtr);
NRE_ASSERT(iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr);
@@ -8392,6 +8423,16 @@ NRCoroutineExitCallback(
iPtr->execEnvPtr = corPtr->callerEEPtr;
+ /*
+ * #280.
+ * Drop the coroutine-owned copy of the lineLABCPtr hashtable for literal
+ * command arguments in bytecode.
+ */
+
+ Tcl_DeleteHashTable(corPtr->base.lineLABCPtr);
+ ckfree((char *) corPtr->base.lineLABCPtr);
+ corPtr->base.lineLABCPtr = NULL;
+
return result;
}
@@ -8555,6 +8596,45 @@ TclNRCoroutineObjCmd(
corPtr->running = NULL_CONTEXT;
/*
+ * #280.
+ * Provide the new coroutine with its own copy of the lineLABCPtr
+ * hashtable for literal command arguments in bytecode. Note that that
+ * CFWordBC chains are not duplicated, only the entrypoints to them. This
+ * means that in the presence of coroutines each chain is potentially a
+ * tree. Like the chain -> tree conversion of the CmdFrame stack.
+ */
+
+ {
+ Tcl_HashSearch hSearch;
+ Tcl_HashEntry* hePtr;
+
+ corPtr->base.lineLABCPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(corPtr->base.lineLABCPtr, TCL_ONE_WORD_KEYS);
+
+ for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch);
+ hePtr;
+ hePtr = Tcl_NextHashEntry(&hSearch)) {
+ int isNew;
+ Tcl_HashEntry* newPtr =
+ Tcl_CreateHashEntry(corPtr->base.lineLABCPtr,
+ (char *) Tcl_GetHashKey (iPtr->lineLABCPtr, hePtr),
+ &isNew);
+ Tcl_SetHashValue(newPtr, Tcl_GetHashValue(hePtr));
+ }
+
+ /*
+ * The new copy is immediately plugged interpreter for use by the
+ * first coroutine commands (see below). The interp's copy of the
+ * table is already saved, see the SAVE_CONTEXT found just above this
+ * whole code block. This also properly prepares us for the
+ * SAVE/RESTORE dances during yields which swizzle the pointers
+ * around.
+ */
+
+ iPtr->lineLABCPtr = corPtr->base.lineLABCPtr;
+ }
+
+ /*
* Eval things in 'uplevel #0', except for the very first command lookup
* which should be looked up in caller's context.
*