summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2008-07-30 17:54:21 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2008-07-30 17:54:21 (GMT)
commite251dd2937f9caaf882a32adb4d40f787a7e00d3 (patch)
tree99e4b2f38fbb38b741e85cb9fabb9056d04976ed
parente86d18adcb954c6cdaa595f47a553ababe192fa7 (diff)
downloadtcl-e251dd2937f9caaf882a32adb4d40f787a7e00d3.zip
tcl-e251dd2937f9caaf882a32adb4d40f787a7e00d3.tar.gz
tcl-e251dd2937f9caaf882a32adb4d40f787a7e00d3.tar.bz2
* generic/tclBasic.c (TclNREvalObjEx): new comments and code reorg
to clarify what is happening.
-rw-r--r--ChangeLog3
-rw-r--r--generic/tclBasic.c166
2 files changed, 92 insertions, 77 deletions
diff --git a/ChangeLog b/ChangeLog
index 511aef8..9c277fa 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
2008-07-30 Miguel Sofer <msofer@users.sf.net>
+ * generic/tclBasic.c (TclNREvalObjEx): new comments and code reorg
+ to clarify what is happening.
+
* generic/tclBasic.c: guard against the value of iPtr->evalFlags
changing between the times where TEOV and TEOV_exception
run. Thanks dgp for catching this.
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 028fb1e..fd93641 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.337 2008/07/30 17:34:52 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.338 2008/07/30 17:54:23 msofer Exp $
*/
#include "tclInt.h"
@@ -5657,15 +5657,16 @@ TclNREvalObjEx(
const CmdFrame *invoker, /* Frame of the command doing the eval. */
int word) /* Index of the word which is in objPtr. */
{
- register Interp *iPtr = (Interp *) interp;
- char *script;
- int numSrcBytes;
+ Interp *iPtr = (Interp *) interp;
int result;
- int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
List *listRepPtr = objPtr->internalRep.twoPtrValue.ptr1;
- Tcl_IncrRefCount(objPtr);
-
+ /*
+ * This function consists of three independent blocks for: direct
+ * evaluation of canonical lists, compileation and bytecode execution and
+ * finally direct evaluation. Precisely one of these blocks will be run.
+ */
+
if ((objPtr->typePtr == &tclListType) && /* is a list... */
((objPtr->bytes == NULL || /* ...without a string rep */
listRepPtr->canonicalFlag))) { /* ...or that is canonical */
@@ -5727,11 +5728,13 @@ TclNREvalObjEx(
/*
* Shimmer protection! Always pass an unshared obj. The caller could
* incr the refCount of objPtr AFTER calling us! To be completely safe
- * we always make a copy.
+ * we always make a copy. The callback takes care od the refCounts for
+ * both listPtr and objPtr.
*
* FIXME OPT: preserve just the internal rep?
*/
+ Tcl_IncrRefCount(objPtr);
listPtr = TclListObjCopy(interp, objPtr);
Tcl_IncrRefCount(listPtr);
TclNRAddCallback(interp, TEOEx_ListCallback, objPtr, eoFramePtr,
@@ -5749,6 +5752,7 @@ TclNREvalObjEx(
* We transfer this to the byte code compiler.
*/
+ int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
ByteCode *codePtr;
CallFrame *savedVarFramePtr = NULL; /* Saves old copy of
* iPtr->varFramePtr in case
@@ -5758,6 +5762,7 @@ TclNREvalObjEx(
savedVarFramePtr = iPtr->varFramePtr;
iPtr->varFramePtr = iPtr->rootFramePtr;
}
+ Tcl_IncrRefCount(objPtr);
codePtr = TclCompileObj(interp, objPtr, invoker, word);
TclNRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr,
@@ -5766,91 +5771,98 @@ TclNREvalObjEx(
return TCL_OK;
}
- /*
- * We're not supposed to use the compiler or byte-code interpreter. Let
- * Tcl_EvalEx evaluate the command directly (and probably more slowly).
- *
- * TIP #280. Propagate context as much as we can. Especially if the script
- * to evaluate is a single literal it makes sense to look if our context
- * is one with absolute line numbers we can then track into the literal
- * itself too.
- *
- * See also tclCompile.c, TclInitCompileEnv, for the equivalent code in
- * the bytecode compiler.
- */
-
- if (invoker == NULL) {
- /*
- * No context, force opening of our own.
- */
-
- script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
- result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
- } else {
+ {
/*
- * We have an invoker, describing the command asking for the
- * evaluation of a subordinate script. This script may originate in a
- * literal word, or from a variable, etc. Using the line array we now
- * check if we have good line information for the relevant word. The
- * type of context is relevant as well. In a non-'source' context we
- * don't have to try tracking lines.
+ * We're not supposed to use the compiler or byte-code
+ * interpreter. Let Tcl_EvalEx evaluate the command directly (and
+ * probably more slowly).
+ *
+ * TIP #280. Propagate context as much as we can. Especially if the
+ * script to evaluate is a single literal it makes sense to look if
+ * our context is one with absolute line numbers we can then track
+ * into the literal itself too.
*
- * First see if the word exists and is a literal. If not we go through
- * the easy dynamic branch. No need to perform more complex
- * invokations.
+ * See also tclCompile.c, TclInitCompileEnv, for the equivalent code
+ * in the bytecode compiler.
*/
- int pc = 0;
- CmdFrame *ctxPtr = (CmdFrame *)
- TclStackAlloc(interp, sizeof(CmdFrame));
-
- *ctxPtr = *invoker;
- if (invoker->type == TCL_LOCATION_BC) {
- /*
- * Note: Type BC => ctxPtr->data.eval.path is not used.
- * ctxPtr->data.tebc.codePtr is used instead.
- */
-
- TclGetSrcInfoForPc(ctxPtr);
- pc = 1;
- }
-
- script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
-
- if ((invoker->nline <= word) ||
- (invoker->line[word] < 0) ||
- (ctxPtr->type != TCL_LOCATION_SOURCE)) {
+ char *script;
+ int numSrcBytes;
+
+ Tcl_IncrRefCount(objPtr);
+ if (invoker == NULL) {
/*
- * Dynamic script, or dynamic context, force our own context.
+ * No context, force opening of our own.
*/
-
+
+ script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
-
} else {
/*
- * Absolute context to reuse.
+ * We have an invoker, describing the command asking for the
+ * evaluation of a subordinate script. This script may originate in a
+ * literal word, or from a variable, etc. Using the line array we now
+ * check if we have good line information for the relevant word. The
+ * type of context is relevant as well. In a non-'source' context we
+ * don't have to try tracking lines.
+ *
+ * First see if the word exists and is a literal. If not we go through
+ * the easy dynamic branch. No need to perform more complex
+ * invokations.
*/
-
- iPtr->invokeCmdFramePtr = ctxPtr;
- iPtr->evalFlags |= TCL_EVAL_CTX;
-
- result = TclEvalEx(interp, script, numSrcBytes, flags,
- ctxPtr->line[word]);
-
- if (pc) {
+
+ int pc = 0;
+ CmdFrame *ctxPtr = (CmdFrame *)
+ TclStackAlloc(interp, sizeof(CmdFrame));
+
+ *ctxPtr = *invoker;
+ if (invoker->type == TCL_LOCATION_BC) {
/*
- * Death of SrcInfo reference.
+ * Note: Type BC => ctxPtr->data.eval.path is not used.
+ * ctxPtr->data.tebc.codePtr is used instead.
*/
-
- Tcl_DecrRefCount(ctxPtr->data.eval.path);
+
+ TclGetSrcInfoForPc(ctxPtr);
+ pc = 1;
}
+
+ script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+
+ if ((invoker->nline <= word) ||
+ (invoker->line[word] < 0) ||
+ (ctxPtr->type != TCL_LOCATION_SOURCE)) {
+ /*
+ * Dynamic script, or dynamic context, force our own context.
+ */
+
+ result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
+
+ } else {
+ /*
+ * Absolute context to reuse.
+ */
+
+ iPtr->invokeCmdFramePtr = ctxPtr;
+ iPtr->evalFlags |= TCL_EVAL_CTX;
+
+ result = TclEvalEx(interp, script, numSrcBytes, flags,
+ ctxPtr->line[word]);
+
+ if (pc) {
+ /*
+ * Death of SrcInfo reference.
+ */
+
+ Tcl_DecrRefCount(ctxPtr->data.eval.path);
+ }
+ }
+ TclStackFree(interp, ctxPtr);
}
- TclStackFree(interp, ctxPtr);
+ TclDecrRefCount(objPtr);
+ return result;
}
- TclDecrRefCount(objPtr);
- return result;
}
-
+
static int
TEOEx_ByteCodeCallback(
ClientData data[],