From ca62a26f9972222ac1357de0376c06052d7cd905 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 7 Mar 2008 19:26:22 +0000 Subject: * generic/tclExecute.c (Tcl_ExprObj): Revised expression bytecode compiling so that bytecodes invalid due to changing context or due to the difference between expressions and scripts are not reused. [Bug 1899164]. --- ChangeLog | 5 ++ generic/tclExecute.c | 148 +++++++++++++++++++++++++++++++++++++-------------- 2 files changed, 112 insertions(+), 41 deletions(-) diff --git a/ChangeLog b/ChangeLog index ea36890..cce551f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,10 @@ 2008-03-07 Don Porter + * generic/tclExecute.c (Tcl_ExprObj): Revised expression bytecode + compiling so that bytecodes invalid due to changing context or due + to the difference between expressions and scripts are not reused. + [Bug 1899164]. + * generic/tclCmdAH.c: Revised direct evaluation implementation of [expr] so that [expr $e] caches compiled bytecodes for the expression as the intrep of $e. diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 25df0e7..78296fd 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.364 2008/02/29 21:02:20 dgp Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.365 2008/03/07 19:26:22 dgp Exp $ */ #include "tclInt.h" @@ -597,7 +597,16 @@ static int EvalStatsCmd(ClientData clientData, #endif /* TCL_COMPILE_STATS */ #ifdef TCL_COMPILE_DEBUG static char * GetOpcodeName(unsigned char *pc); +static void PrintByteCodeInfo(ByteCode *codePtr); +static const char * StringForResultCode(int result); +static void ValidatePcAndStackTop(ByteCode *codePtr, + unsigned char *pc, int stackTop, + int stackLowerBound, int checkStack); #endif /* TCL_COMPILE_DEBUG */ +static void DeleteExecStack(ExecStack *esPtr); +static void DupExprCodeInternalRep(Tcl_Obj *srcPtr, + Tcl_Obj *copyPtr); +static void FreeExprCodeInternalRep(Tcl_Obj *objPtr); static ExceptionRange * GetExceptRangeForPc(unsigned char *pc, int catchOnly, ByteCode *codePtr); static const char * GetSrcInfoForPc(unsigned char *pc, ByteCode *codePtr, @@ -607,17 +616,22 @@ static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, int growth, static void IllegalExprOperandType(Tcl_Interp *interp, unsigned char *pc, Tcl_Obj *opndPtr); static void InitByteCodeExecution(Tcl_Interp *interp); -#ifdef TCL_COMPILE_DEBUG -static void PrintByteCodeInfo(ByteCode *codePtr); -static const char * StringForResultCode(int result); -static void ValidatePcAndStackTop(ByteCode *codePtr, - unsigned char *pc, int stackTop, - int stackLowerBound, int checkStack); -#endif /* TCL_COMPILE_DEBUG */ -static void DeleteExecStack(ExecStack *esPtr); /* Useful elsewhere, make available in tclInt.h or stubs? */ static Tcl_Obj ** StackAllocWords(Tcl_Interp *interp, int numWords); static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, int numWords); + +/* + * The structure below defines a bytecode Tcl object type to hold the + * compiled bytecode for Tcl expressions. + */ + +static Tcl_ObjType exprCodeType = { + "exprcode", + FreeExprCodeInternalRep, /* freeIntRepProc */ + DupExprCodeInternalRep, /* dupIntRepProc */ + NULL, /* updateStringProc */ + NULL /* setFromAnyProc */ +}; /* *---------------------------------------------------------------------- @@ -1190,36 +1204,32 @@ Tcl_ExprObj( register ByteCode *codePtr = NULL; /* Tcl Internal type of bytecode. Initialized * to avoid compiler warning. */ - Tcl_Obj *saveObjPtr; int result; /* - * Get the ByteCode from the object. If it exists, make sure it hasn't - * been invalidated by, e.g., someone redefining a command with a compile - * procedure (this might make the compiled code wrong). If necessary, - * convert the object to be a ByteCode object and compile it. Also, if the - * code was compiled in/for a different interpreter, we recompile it. - * - * Precompiled expressions, however, are immutable and therefore they are - * not recompiled, even if the epoch has changed. + * Execute the expression after first saving the interpreter's result. */ - if (objPtr->typePtr == &tclByteCodeType) { + Tcl_Obj *saveObjPtr = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(saveObjPtr); + + /* + * Get the expression ByteCode from the object. If it exists, make sure it + * is valid in the current context. If not + */ + if (objPtr->typePtr == &exprCodeType) { + Namespace *namespacePtr = iPtr->varFramePtr->nsPtr; + codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr; if (((Interp *) *codePtr->interpHandle != iPtr) - || (codePtr->compileEpoch != iPtr->compileEpoch)) { - if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) { - if ((Interp *) *codePtr->interpHandle != iPtr) { - Tcl_Panic("Tcl_ExprObj: compiled expression jumped interps"); - } - codePtr->compileEpoch = iPtr->compileEpoch; - } else { - objPtr->typePtr->freeIntRepProc(objPtr); - objPtr->typePtr = (Tcl_ObjType *) NULL; - } + || (codePtr->compileEpoch != iPtr->compileEpoch) + || (codePtr->nsPtr != namespacePtr) + || (codePtr->nsEpoch != namespacePtr->resolverEpoch)) { + objPtr->typePtr->freeIntRepProc(objPtr); + objPtr->typePtr = (Tcl_ObjType *) NULL; } } - if (objPtr->typePtr != &tclByteCodeType) { + if (objPtr->typePtr != &exprCodeType) { /* * TIP #280: No invoker (yet) - Expression compilation. */ @@ -1248,6 +1258,7 @@ Tcl_ExprObj( TclEmitOpcode(INST_DONE, &compEnv); TclInitByteCodeObj(objPtr, &compEnv); + objPtr->typePtr = &exprCodeType; TclFreeCompileEnv(&compEnv); codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr; #ifdef TCL_COMPILE_DEBUG @@ -1258,12 +1269,6 @@ Tcl_ExprObj( #endif /* TCL_COMPILE_DEBUG */ } - /* - * Execute the expression after first saving the interpreter's result. - */ - - saveObjPtr = Tcl_GetObjResult(interp); - Tcl_IncrRefCount(saveObjPtr); Tcl_ResetResult(interp); /* @@ -1276,8 +1281,6 @@ Tcl_ExprObj( codePtr->refCount--; if (codePtr->refCount <= 0) { TclCleanupByteCode(codePtr); - objPtr->typePtr = NULL; - objPtr->internalRep.otherValuePtr = NULL; } /* @@ -1302,6 +1305,72 @@ Tcl_ExprObj( /* *---------------------------------------------------------------------- * + * DupExprCodeInternalRep -- + * + * Part of the Tcl object type implementation for Tcl expression + * bytecode. We do not copy the bytecode intrep. Instead, we + * return with setting copyPtr->typePtr, so the copy is a plain + * string copy of the expression value, and if it is to be used + * as a compiled expression, it will just need a recompile. + * + * This makes sense, because with Tcl's copy-on-write practices, + * the usual (only?) time Tcl_DuplicateObj() will be called is + * when the copy is about to be modified, which would invalidate + * any copied bytecode anyway. The only reason it might make sense + * to copy the bytecode is if we had some modifying routines that + * operated directly on the intrep, like we do for lists and dicts. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +DupExprCodeInternalRep( + Tcl_Obj *srcPtr, + Tcl_Obj *copyPtr) +{ + return; +} + +/* + *---------------------------------------------------------------------- + * + * FreeExprCodeInternalRep -- + * + * Part of the Tcl object type implementation for Tcl expression + * bytecode. Frees the storage allocated to hold the internal rep, + * unless ref counts indicate bytecode execution is still in progress. + * + * Results: + * None. + * + * Side effects: + * + *---------------------------------------------------------------------- + */ + +static void +FreeExprCodeInternalRep( + Tcl_Obj *objPtr) +{ + ByteCode *codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr; + + codePtr->refCount--; + if (codePtr->refCount <= 0) { + TclCleanupByteCode(codePtr); + } + objPtr->typePtr = NULL; + objPtr->internalRep.otherValuePtr = NULL; +} + +/* + *---------------------------------------------------------------------- + * * TclCompEvalObj -- * * This procedure evaluates the script contained in a Tcl_Obj by first @@ -1372,9 +1441,6 @@ TclCompEvalObj( codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr; if (((Interp *) *codePtr->interpHandle != iPtr) || (codePtr->compileEpoch != iPtr->compileEpoch) -#ifdef CHECK_PROC_ORIGINATION /* [Bug: 3412 Pedantic] */ - || codePtr->procPtr != iPtr->varFramePtr->procPtr -#endif || (codePtr->nsPtr != namespacePtr) || (codePtr->nsEpoch != namespacePtr->resolverEpoch)) { if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) { -- cgit v0.12