summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2008-03-07 19:26:22 (GMT)
committerdgp <dgp@users.sourceforge.net>2008-03-07 19:26:22 (GMT)
commitca62a26f9972222ac1357de0376c06052d7cd905 (patch)
tree24be8d00cbf61204f8f80bb5e91fd181438be8a2 /generic
parent1d90d3f1d30da3d67a75b4035f4b9099e96e4732 (diff)
downloadtcl-ca62a26f9972222ac1357de0376c06052d7cd905.zip
tcl-ca62a26f9972222ac1357de0376c06052d7cd905.tar.gz
tcl-ca62a26f9972222ac1357de0376c06052d7cd905.tar.bz2
* 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].
Diffstat (limited to 'generic')
-rw-r--r--generic/tclExecute.c148
1 files changed, 107 insertions, 41 deletions
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) {