summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2013-07-15 20:16:11 (GMT)
committerdgp <dgp@users.sourceforge.net>2013-07-15 20:16:11 (GMT)
commitd860a2c3a49e049350838d0ee2e259e7f8b4c3e6 (patch)
tree4de2dd1c77a23d0b972d4e40b212d5a830f33aa2
parent009f2adf3dad0d3eb86598f988fc93c8a64f6f2a (diff)
downloadtcl-d860a2c3a49e049350838d0ee2e259e7f8b4c3e6.zip
tcl-d860a2c3a49e049350838d0ee2e259e7f8b4c3e6.tar.gz
tcl-d860a2c3a49e049350838d0ee2e259e7f8b4c3e6.tar.bz2
Build CompileBasicNArgCommand on top of TclCompileInvocation.
-rw-r--r--generic/tclBasic.c22
-rw-r--r--generic/tclCompile.c6
-rw-r--r--generic/tclCompile.h3
-rw-r--r--generic/tclEnsemble.c10
4 files changed, 34 insertions, 7 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index b2a505a..963b53a 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -5633,6 +5633,24 @@ TclArgumentBCEnter(
CFWordBC *lastPtr = NULL;
/*
+ * ePtr->nline is the number of words originally parsed.
+ *
+ * objc is the number of elements getting invoked.
+ *
+ * If they are not the same, we arrived here by compiling an
+ * ensemble dispatch. Ensemble subcommands that lead to script
+ * evaluation are not supposed to get compiled, because a command
+ * such as [info level] in the script can expose some of the dispatch
+ * shenanigans. This means that we don't have to tend to the
+ * housekeeping, and can escape now.
+ */
+
+ if (ePtr->nline != objc) {
+ return;
+ }
+
+ /*
+ * Having disposed of the ensemble cases, we can state...
* A few truths ...
* (1) ePtr->nline == objc
* (2) (ePtr->line[word] < 0) => !literal, for all words
@@ -5642,10 +5660,6 @@ TclArgumentBCEnter(
* have to save them at compile time.
*/
- if (ePtr->nline != objc) {
- Tcl_Panic ("TIP 280 data structure inconsistency");
- }
-
for (word = 1; word < objc; word++) {
if (ePtr->line[word] >= 0) {
int isnew;
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 5f4acff..a2c7131 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1777,8 +1777,8 @@ CompileCmdLiteral(
TclEmitPush(cmdLitIdx, envPtr);
}
-static void
-CompileInvocation(
+void
+TclCompileInvocation(
Tcl_Interp *interp,
Tcl_Token *tokenPtr,
Tcl_Obj *cmdObj,
@@ -2095,7 +2095,7 @@ CompileCommandTokens(
CompileExpanded(interp, parsePtr->tokenPtr,
cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr);
} else {
- CompileInvocation(interp, parsePtr->tokenPtr,
+ TclCompileInvocation(interp, parsePtr->tokenPtr,
cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr);
}
}
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 0bcd84e..b94bd93 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1003,6 +1003,9 @@ MODULE_SCOPE void TclCompileExpr(Tcl_Interp *interp, const char *script,
MODULE_SCOPE void TclCompileExprWords(Tcl_Interp *interp,
Tcl_Token *tokenPtr, int numWords,
CompileEnv *envPtr);
+MODULE_SCOPE void TclCompileInvocation(Tcl_Interp *interp,
+ Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, int numWords,
+ CompileEnv *envPtr);
MODULE_SCOPE void TclCompileScript(Tcl_Interp *interp,
const char *script, int numBytes,
CompileEnv *envPtr);
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 680ab45d..9b6ca92 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -3229,6 +3229,15 @@ CompileBasicNArgCommand(
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
+#if 1
+ Tcl_Obj *objPtr = Tcl_NewObj();
+
+ Tcl_IncrRefCount(objPtr);
+ Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
+ TclCompileInvocation(interp, parsePtr->tokenPtr, objPtr,
+ parsePtr->numWords, envPtr);
+ Tcl_DecrRefCount(objPtr);
+#else
Tcl_Token *tokenPtr;
Tcl_Obj *objPtr;
char *bytes;
@@ -3272,6 +3281,7 @@ CompileBasicNArgCommand(
} else {
TclEmitInstInt4(INST_INVOKE_STK4, i, envPtr);
}
+#endif
return TCL_OK;
}