summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2007-11-16 14:11:50 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2007-11-16 14:11:50 (GMT)
commit837b9c9c7f6f3f01e286eb8ab111b268eba47842 (patch)
tree752c216216cf230e79bafdc10e22bb4d6d97502c
parent7ac80cab9e7494b78ed8010a98bd096e83cd5955 (diff)
downloadtcl-837b9c9c7f6f3f01e286eb8ab111b268eba47842.zip
tcl-837b9c9c7f6f3f01e286eb8ab111b268eba47842.tar.gz
tcl-837b9c9c7f6f3f01e286eb8ab111b268eba47842.tar.bz2
Greatly improved ensemble compiler. This one now can handle any ensemble.
It is usually not enabled though; only worth it when a subcommand is actually expected to undergo bytecode compilation.
-rw-r--r--ChangeLog14
-rw-r--r--generic/tclCmdIL.c70
-rw-r--r--generic/tclCompCmds.c355
-rw-r--r--generic/tclCompile.c7
-rw-r--r--generic/tclInt.h168
-rw-r--r--generic/tclNamesp.c36
-rw-r--r--tests/namespace.test4
-rw-r--r--tests/trace.test4
8 files changed, 487 insertions, 171 deletions
diff --git a/ChangeLog b/ChangeLog
index 3d3b73d..602de31 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2007-11-16 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclCmdIL.c (TclInitInfoCmd): Rename the implementation
+ commands for [info] to be something more "expected".
+
+ * generic/tclCompCmds.c (TclCompileInfoExistsCmd): Compiler for the
+ [info exists] subcommand.
+ (TclCompileEnsemble): Cleaned up version of ensemble compiler that was
+ in TclCompileInfoCmd, but which is now much more generally applicable.
+ * generic/tclInt.h (ENSEMBLE_COMPILE): Added flag to allow for cleaner
+ turning on and off of ensemble bytecode compilation.
+ * generic/tclCompile.c (TclCompileScript): Add the cmdPtr to the list
+ of arguments passed to command compilers.
+
2007-11-15 Don Porter <dgp@users.sourceforge.net>
* generic/regc_nfa.c: Fixed infinite loop in the regexp compiler.
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 2647a4c..8c3262e 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.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: tclCmdIL.c,v 1.125 2007/11/14 23:05:01 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.126 2007/11/16 14:11:51 dkf Exp $
*/
#include "tclInt.h"
@@ -152,30 +152,31 @@ static Tcl_Obj * SelectObjFromSublist(Tcl_Obj *firstPtr,
static const struct {
const char *name; /* The name of the subcommand. */
Tcl_ObjCmdProc *proc; /* The implementation of the subcommand. */
+ CompileProc *compileProc; /* The compiler for the subcommand. */
} defaultInfoMap[] = {
- {"args", InfoArgsCmd},
- {"body", InfoBodyCmd},
- {"cmdcount", InfoCmdCountCmd},
- {"commands", InfoCommandsCmd},
- {"complete", InfoCompleteCmd},
- {"default", InfoDefaultCmd},
- {"exists", TclInfoExistsCmd},
- {"frame", InfoFrameCmd},
- {"functions", InfoFunctionsCmd},
- {"globals", TclInfoGlobalsCmd},
- {"hostname", InfoHostnameCmd},
- {"level", InfoLevelCmd},
- {"library", InfoLibraryCmd},
- {"loaded", InfoLoadedCmd},
- {"locals", TclInfoLocalsCmd},
- {"nameofexecutable",InfoNameOfExecutableCmd},
- {"patchlevel", InfoPatchLevelCmd},
- {"procs", InfoProcsCmd},
- {"script", InfoScriptCmd},
- {"sharedlibextension", InfoSharedlibCmd},
- {"tclversion", InfoTclVersionCmd},
- {"vars", TclInfoVarsCmd},
- {NULL, NULL}
+ {"args", InfoArgsCmd, NULL},
+ {"body", InfoBodyCmd, NULL},
+ {"cmdcount", InfoCmdCountCmd, NULL},
+ {"commands", InfoCommandsCmd, NULL},
+ {"complete", InfoCompleteCmd, NULL},
+ {"default", InfoDefaultCmd, NULL},
+ {"exists", TclInfoExistsCmd, TclCompileInfoExistsCmd},
+ {"frame", InfoFrameCmd, NULL},
+ {"functions", InfoFunctionsCmd, NULL},
+ {"globals", TclInfoGlobalsCmd, NULL},
+ {"hostname", InfoHostnameCmd, NULL},
+ {"level", InfoLevelCmd, NULL},
+ {"library", InfoLibraryCmd, NULL},
+ {"loaded", InfoLoadedCmd, NULL},
+ {"locals", TclInfoLocalsCmd, NULL},
+ {"nameofexecutable", InfoNameOfExecutableCmd, NULL},
+ {"patchlevel", InfoPatchLevelCmd, NULL},
+ {"procs", InfoProcsCmd, NULL},
+ {"script", InfoScriptCmd, NULL},
+ {"sharedlibextension", InfoSharedlibCmd, NULL},
+ {"tclversion", InfoTclVersionCmd, NULL},
+ {"vars", TclInfoVarsCmd, NULL},
+ {NULL, NULL, NULL}
};
/*
@@ -395,8 +396,13 @@ TclInitInfoCmd(
if (tclNsPtr == NULL) {
Tcl_Panic("unable to find or create ::tcl namespace!");
}
+ tclNsPtr = Tcl_FindNamespace(interp, "::tcl::info", NULL,
+ TCL_CREATE_NS_IF_UNKNOWN);
+ if (tclNsPtr == NULL) {
+ Tcl_Panic("unable to find or create ::tcl::info namespace!");
+ }
ensemble = Tcl_CreateEnsemble(interp, "::info", tclNsPtr,
- TCL_ENSEMBLE_PREFIX);
+ TCL_ENSEMBLE_PREFIX | ENSEMBLE_COMPILE);
if (ensemble != NULL) {
Tcl_Obj *mapDict;
int i;
@@ -404,23 +410,19 @@ TclInitInfoCmd(
TclNewObj(mapDict);
for (i=0 ; defaultInfoMap[i].name != NULL ; i++) {
Tcl_Obj *fromObj, *toObj;
+ Command *cmdPtr;
fromObj = Tcl_NewStringObj(defaultInfoMap[i].name, -1);
- TclNewLiteralStringObj(toObj, "::tcl::Info_");
+ TclNewLiteralStringObj(toObj, "::tcl::info::");
Tcl_AppendToObj(toObj, defaultInfoMap[i].name, -1);
Tcl_DictObjPut(NULL, mapDict, fromObj, toObj);
- Tcl_CreateObjCommand(interp, TclGetString(toObj),
- defaultInfoMap[i].proc, NULL, NULL);
+ cmdPtr = (Command *) Tcl_CreateObjCommand(interp,
+ TclGetString(toObj), defaultInfoMap[i].proc, NULL, NULL);
+ cmdPtr->compileProc = defaultInfoMap[i].compileProc;
}
Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
}
- /*
- * Enable compilation of the [info exists] subcommand.
- */
-
- ((Command *)ensemble)->compileProc = &TclCompileInfoCmd;
-
return ensemble;
}
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 02cf81c..ba85435 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompCmds.c,v 1.127 2007/11/14 23:05:01 dkf Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.128 2007/11/16 14:11:52 dkf Exp $
*/
#include "tclInt.h"
@@ -224,6 +224,8 @@ TclCompileAppendCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
@@ -238,7 +240,7 @@ TclCompileAppendCmd(
* append varName == set varName
*/
- return TclCompileSetCmd(interp, parsePtr, envPtr);
+ return TclCompileSetCmd(interp, parsePtr, cmdPtr, envPtr);
} else if (numWords > 3) {
/*
* APPEND instructions currently only handle one value.
@@ -324,6 +326,8 @@ TclCompileBreakCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
if (parsePtr->numWords != 1) {
@@ -361,6 +365,8 @@ TclCompileCatchCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
JumpFixup jumpFixup;
@@ -559,6 +565,8 @@ TclCompileContinueCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
/*
@@ -600,6 +608,8 @@ TclCompileDictCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr;
@@ -1178,6 +1188,8 @@ TclCompileExprCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *firstWordPtr;
@@ -1221,6 +1233,8 @@ TclCompileForCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
@@ -1385,6 +1399,8 @@ TclCompileForeachCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Proc *procPtr = envPtr->procPtr;
@@ -1847,6 +1863,8 @@ TclCompileIfCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
JumpFixupArray jumpFalseFixupArray;
@@ -2162,6 +2180,8 @@ TclCompileIncrCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr, *incrTokenPtr;
@@ -2279,6 +2299,8 @@ TclCompileLappendCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr;
@@ -2386,6 +2408,8 @@ TclCompileLassignCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr;
@@ -2499,6 +2523,8 @@ TclCompileLindexCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *idxTokenPtr, *valTokenPtr;
@@ -2594,6 +2620,8 @@ TclCompileListCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
@@ -2656,6 +2684,8 @@ TclCompileLlengthCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr;
@@ -2716,6 +2746,8 @@ TclCompileLsetCmd(
Tcl_Interp *interp, /* Tcl interpreter for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the
* command. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
int tempDepth; /* Depth used for emitting one part of the
@@ -2872,6 +2904,8 @@ TclCompileRegexpCmd(
Tcl_Interp *interp, /* Tcl interpreter for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the
* command. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the
@@ -3025,6 +3059,8 @@ TclCompileReturnCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
/*
@@ -3216,6 +3252,8 @@ TclCompileSetCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
@@ -3315,6 +3353,8 @@ TclCompileStringCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
@@ -3534,6 +3574,8 @@ TclCompileSwitchCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr; /* Pointer to tokens in command. */
@@ -4367,6 +4409,8 @@ TclCompileWhileCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *testTokenPtr, *bodyTokenPtr;
@@ -5001,6 +5045,8 @@ int
TclCompileInvertOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
return CompileUnaryOpCmd(interp, parsePtr, INST_BITNOT, envPtr);
@@ -5010,6 +5056,8 @@ int
TclCompileNotOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
return CompileUnaryOpCmd(interp, parsePtr, INST_LNOT, envPtr);
@@ -5019,6 +5067,8 @@ int
TclCompileAddOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_ADD,
@@ -5029,6 +5079,8 @@ int
TclCompileMulOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
return CompileAssociativeBinaryOpCmd(interp, parsePtr, "1", INST_MULT,
@@ -5039,6 +5091,8 @@ int
TclCompileAndOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
return CompileAssociativeBinaryOpCmd(interp, parsePtr, "-1", INST_BITAND,
@@ -5049,6 +5103,8 @@ int
TclCompileOrOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_BITOR,
@@ -5059,6 +5115,8 @@ int
TclCompileXorOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_BITXOR,
@@ -5069,6 +5127,8 @@ int
TclCompilePowOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
/*
@@ -5097,6 +5157,8 @@ int
TclCompileLshiftOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LSHIFT, envPtr);
@@ -5106,6 +5168,8 @@ int
TclCompileRshiftOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_RSHIFT, envPtr);
@@ -5115,6 +5179,8 @@ int
TclCompileModOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_MOD, envPtr);
@@ -5124,6 +5190,8 @@ int
TclCompileNeqOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_NEQ, envPtr);
@@ -5133,6 +5201,8 @@ int
TclCompileStrneqOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_STR_NEQ, envPtr);
@@ -5142,6 +5212,8 @@ int
TclCompileInOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LIST_IN, envPtr);
@@ -5151,6 +5223,8 @@ int
TclCompileNiOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LIST_NOT_IN,
@@ -5161,6 +5235,8 @@ int
TclCompileLessOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
return CompileComparisonOpCmd(interp, parsePtr, INST_LT, envPtr);
@@ -5170,6 +5246,8 @@ int
TclCompileLeqOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
return CompileComparisonOpCmd(interp, parsePtr, INST_LE, envPtr);
@@ -5179,6 +5257,8 @@ int
TclCompileGreaterOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
return CompileComparisonOpCmd(interp, parsePtr, INST_GT, envPtr);
@@ -5188,6 +5268,8 @@ int
TclCompileGeqOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
return CompileComparisonOpCmd(interp, parsePtr, INST_GE, envPtr);
@@ -5197,6 +5279,8 @@ int
TclCompileEqOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
return CompileComparisonOpCmd(interp, parsePtr, INST_EQ, envPtr);
@@ -5206,6 +5290,8 @@ int
TclCompileStreqOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
return CompileComparisonOpCmd(interp, parsePtr, INST_STR_EQ, envPtr);
@@ -5215,6 +5301,8 @@ int
TclCompileMinusOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
@@ -5253,6 +5341,8 @@ int
TclCompileDivOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr)
{
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
@@ -5308,7 +5398,7 @@ TclCompileDivOpCmd(
static int
IndexTailVarIfKnown(
Tcl_Interp *interp,
- Tcl_Token *varTokenPtr, /* Token representing the variable name */
+ Tcl_Token *varTokenPtr, /* Token representing the variable name */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Obj *tailPtr;
@@ -5406,6 +5496,8 @@ TclCompileUpvarCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
@@ -5515,6 +5607,8 @@ TclCompileNamespaceCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
@@ -5605,6 +5699,8 @@ TclCompileGlobalCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr;
@@ -5678,6 +5774,8 @@ TclCompileVariableCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
@@ -5737,109 +5835,230 @@ TclCompileVariableCmd(
/*
*----------------------------------------------------------------------
*
- * TclCompileInfoCmd --
+ * TclCompileEnsemble --
*
- * Procedure called to compile the "info" command. Only handles the
- * "exists" subcommand.
+ * Procedure called to compile an ensemble command.
*
* Results:
* Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
* evaluation to runtime.
*
* Side effects:
- * Instructions are added to envPtr to execute the "info exists"
- * subcommand at runtime.
+ * Instructions are added to envPtr to execute the subcommands of the
+ * ensemble at runtime if a compile-time mapping is possible.
*
*----------------------------------------------------------------------
*/
int
-TclCompileInfoCmd(
+TclCompileEnsemble(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
- Tcl_Token *tokenPtr;
- int isScalar, simpleVarName, localIndex, numWords;
- DefineLineInformation; /* TIP #280 */
+ Tcl_Token *tokenPtr, *argTokensPtr;
+ Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems;
+ Tcl_Command ensemble = (Tcl_Command) cmdPtr;
+ Tcl_Parse synthetic;
+ int len, numBytes, result;
+ const char *word;
+
+ if (parsePtr->numWords < 2) {
+ return TCL_ERROR;
+ }
+
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ /*
+ * Too hard.
+ */
- numWords = parsePtr->numWords;
- if (numWords != 3) {
return TCL_ERROR;
}
+ word = tokenPtr[1].start;
+ numBytes = tokenPtr[1].size;
+
/*
- * Ensure that the next word is "exists"; that's the only case we will
- * deal with.
+ * There's a sporting chance we'll be able to compile this. But now we
+ * must check properly. To do that, check that we're compiling an
+ * ensemble that has [info exists] as its appropriate subcommand.
*/
- tokenPtr = TokenAfter(parsePtr->tokenPtr);
- if (parsePtr->tokenPtr->type == TCL_TOKEN_SIMPLE_WORD &&
- tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- const char *word = tokenPtr[1].start;
- int numBytes = tokenPtr[1].size;
- Command *cmdPtr;
- Tcl_Obj *mapObj, *existsObj, *targetCmdObj;
- Tcl_DString ds;
-
+ if (Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj) != TCL_OK
+ || mapObj == NULL) {
/*
- * There's a sporting chance we'll be able to compile this. But now we
- * must check properly. To do that, look up what we expect to be
- * called (inefficient, should be in context?) and check that that's
- * an ensemble that has [info exists] as its appropriate subcommand.
+ * Either not an ensemble or a mapping isn't installed. Crud. Too hard
+ * to proceed.
*/
- Tcl_DStringInit(&ds);
- Tcl_DStringAppend(&ds, parsePtr->tokenPtr[1].start,
- parsePtr->tokenPtr[1].size);
- cmdPtr = (Command *) Tcl_FindCommand(interp, Tcl_DStringValue(&ds),
- (Tcl_Namespace *) envPtr->iPtr->globalNsPtr, 0);
- Tcl_DStringFree(&ds);
- if (cmdPtr == NULL || cmdPtr->compileProc != &TclCompileInfoCmd) {
- /*
- * Not [info], and can't be bothered to follow rabbit hole of
- * renaming. This is an optimization, darnit!
- */
+ return TCL_ERROR;
+ }
- return TCL_ERROR;
- }
+ TclNewStringObj(subcmdObj, word, numBytes);
+ if (Tcl_DictObjGet(NULL, mapObj, subcmdObj, &targetCmdObj) != TCL_OK
+ || targetCmdObj == NULL) {
+ /*
+ * We've not got a valid subcommand.
+ */
- if (Tcl_GetEnsembleMappingDict(interp, (Tcl_Command) cmdPtr,
- &mapObj) != TCL_OK || mapObj == NULL) {
- /*
- * Either not an ensemble or a mapping isn't installed. Crud. Too
- * hard to proceed.
- */
+ TclDecrRefCount(subcmdObj);
+ return TCL_ERROR;
+ }
+ TclDecrRefCount(subcmdObj);
- return TCL_ERROR;
- }
+ /*
+ * The command we map to is the first word out of the map element. Note
+ * that we reject dealing with lists that are multiple elements long here;
+ * our rewriting-fu is not yet strong enough.
+ */
- TclNewStringObj(existsObj, word, numBytes);
- if (Tcl_DictObjGet(NULL, mapObj, existsObj, &targetCmdObj) != TCL_OK
- || targetCmdObj == NULL) {
- /*
- * We've not got a valid subcommand.
- */
+ if (Tcl_ListObjGetElements(NULL, targetCmdObj, &len, &elems) != TCL_OK
+ || len != 1) {
+ return TCL_ERROR;
+ }
+ targetCmdObj = elems[0];
+ Tcl_IncrRefCount(targetCmdObj);
- TclDecrRefCount(existsObj);
- return TCL_ERROR;
- }
- TclDecrRefCount(existsObj);
+ /*
+ * Check to see if there's also a subcommand list; must check to see if
+ * the subcommand we are calling is in that list if it exists, since that
+ * list filters the entries in the map.
+ */
- cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj);
- if (cmdPtr == NULL || cmdPtr->objProc != &TclInfoExistsCmd) {
- /*
- * Maps to something unexpected. Help!
- */
+ (void) Tcl_GetEnsembleSubcommandList(NULL, ensemble, &listObj);
+ if (listObj != NULL) {
+ int i, sclen;
+ char *str;
+ if (Tcl_ListObjGetElements(NULL, listObj, &len,&elems) != TCL_OK){
+ TclDecrRefCount(targetCmdObj);
return TCL_ERROR;
}
+ for (i=0 ; i<len ; i++) {
+ str = Tcl_GetStringFromObj(elems[i], &sclen);
+ if (sclen == numBytes &&
+ memcmp(word, str, (unsigned) numBytes) == 0) {
+ goto doneSubcmdListSearch;
+ }
+ }
+ TclDecrRefCount(targetCmdObj);
+ return TCL_ERROR;
+ }
+
+ /*
+ * OK, we definitely map to something. But what?
+ */
+ doneSubcmdListSearch:
+ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj);
+ TclDecrRefCount(targetCmdObj);
+ if (cmdPtr == NULL || cmdPtr->compileProc == NULL) {
/*
- * OK, it really is [info exists]!
+ * Maps to an undefined command or a command without a compiler.
+ * Cannot compile.
*/
+
+ return TCL_ERROR;
+ }
+
+ /*
+ * Should check if we mapped to another ensemble here, and go round the
+ * peek-inside scheme above if so. [TO-DO]
+ */
+
+ /*
+ * Now we've done the mapping process, can now actually try to compile.
+ * We do this by handing off to the subcommand's actual compiler. But to
+ * do that, we have to perform some trickery to rewrite the arguments.
+ */
+
+ argTokensPtr = TokenAfter(tokenPtr);
+ memcpy(&synthetic, parsePtr, sizeof(Tcl_Parse));
+ synthetic.numWords--;
+ synthetic.numTokens -= (argTokensPtr - parsePtr->tokenPtr) - 2;
+ if (synthetic.numTokens <= NUM_STATIC_TOKENS) {
+ synthetic.tokenPtr = synthetic.staticTokens;
+ synthetic.tokensAvailable = NUM_STATIC_TOKENS;
} else {
+ synthetic.tokenPtr = (Tcl_Token *)
+ ckalloc(sizeof(Tcl_Token) * synthetic.numTokens);
+ synthetic.tokensAvailable = synthetic.numTokens;
+ }
+
+ /*
+ * Now we have the space to work in, install something rewritten.
+ */
+
+ synthetic.tokenPtr[0].type = TCL_TOKEN_SIMPLE_WORD;
+ synthetic.tokenPtr[0].start = parsePtr->tokenPtr[0].start;
+ synthetic.tokenPtr[0].size = (tokenPtr->start + tokenPtr->size)
+ - parsePtr->tokenPtr[0].start;
+ synthetic.tokenPtr[0].numComponents = 1;
+
+ synthetic.tokenPtr[1].type = TCL_TOKEN_TEXT;
+ synthetic.tokenPtr[1].start = synthetic.tokenPtr[0].start;
+ synthetic.tokenPtr[1].size = synthetic.tokenPtr[0].size;
+ synthetic.tokenPtr[1].numComponents = 0;
+
+ /*
+ * Copy over the real argument tokens.
+ */
+
+ memcpy(synthetic.tokenPtr + 2, argTokensPtr,
+ sizeof(Tcl_Token) * (synthetic.numTokens - 2));
+
+ /*
+ * Hand off compilation to the subcommand compiler. At last!
+ */
+
+ result = cmdPtr->compileProc(interp, &synthetic, cmdPtr, envPtr);
+
+ /*
+ * Clean up if necessary.
+ */
+
+ if (synthetic.tokenPtr != synthetic.staticTokens) {
+ ckfree((char *) synthetic.tokenPtr);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileInfoExistsCmd --
+ *
+ * Procedure called to compile the "info exists" subcommand.
+ *
+ * Results:
+ * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * evaluation to runtime.
+ *
+ * Side effects:
+ * Instructions are added to envPtr to execute the "info exists"
+ * subcommand at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileInfoExistsCmd(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ Tcl_Parse *parsePtr, /* Points to a parse structure for the command
+ * created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
+ CompileEnv *envPtr) /* Holds resulting instructions. */
+{
+ Tcl_Token *tokenPtr;
+ int isScalar, simpleVarName, localIndex;
+ DefineLineInformation; /* TIP #280 */
+
+ if (parsePtr->numWords != 2) {
return TCL_ERROR;
}
@@ -5851,9 +6070,9 @@ TclCompileInfoCmd(
* qualifiers.
*/
- tokenPtr = TokenAfter(tokenPtr);
+ tokenPtr = TokenAfter(parsePtr->tokenPtr);
PushVarName(interp, tokenPtr, envPtr, TCL_CREATE_VAR, &localIndex,
- &simpleVarName, &isScalar, mapPtr->loc[eclIndex].line[2]);
+ &simpleVarName, &isScalar, mapPtr->loc[eclIndex].line[1]);
/*
* Emit instruction to check the variable for existence.
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 7cf5918..efb652e 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompile.c,v 1.141 2007/11/14 23:05:02 dkf Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.142 2007/11/16 14:11:52 dkf Exp $
*/
#include "tclInt.h"
@@ -1375,7 +1375,8 @@ TclCompileScript(
update = 1;
}
- code = (cmdPtr->compileProc)(interp, parsePtr, envPtr);
+ code = (cmdPtr->compileProc)(interp, parsePtr,
+ cmdPtr, envPtr);
if (code == TCL_OK) {
if (update) {
@@ -1873,6 +1874,8 @@ TclCompileNoOp(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
+ Command *cmdPtr, /* Points to defintion of command being
+ * compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index d7fb7a2..4b6a540 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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: tclInt.h,v 1.346 2007/11/14 23:05:03 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.347 2007/11/16 14:11:52 dkf Exp $
*/
#ifndef _TCLINT
@@ -401,6 +401,12 @@ typedef struct {
} EnsembleCmdRep;
/*
+ * Flag to enable bytecode compilation of an ensemble.
+ */
+
+#define ENSEMBLE_COMPILE 0x4
+
+/*
*----------------------------------------------------------------
* Data structures related to variables. These are used primarily in tclVar.c
*----------------------------------------------------------------
@@ -1257,7 +1263,7 @@ struct CompileEnv;
#define TCL_OUT_LINE_COMPILE TCL_ERROR
typedef int (CompileProc) (Tcl_Interp *interp, Tcl_Parse *parsePtr,
- struct CompileEnv *compEnvPtr);
+ struct Command *cmdPtr, struct CompileEnv *compEnvPtr);
/*
* The type of procedure called from the compilation hook point in
@@ -2924,177 +2930,231 @@ MODULE_SCOPE int Tcl_WhileObjCmd(ClientData clientData,
*/
MODULE_SCOPE int TclCompileAppendCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileBreakCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileCatchCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileContinueCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileDictCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileEnsemble(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileExprCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileForCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileForeachCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
-MODULE_SCOPE int TclCompileGlobalCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileGlobalCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileIfCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
-MODULE_SCOPE int TclCompileInfoCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
+MODULE_SCOPE int TclCompileInfoExistsCmd(Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileIncrCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileLappendCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileLassignCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileLindexCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileListCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileLlengthCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileLsetCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileNamespaceCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileNoOp(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileRegexpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileReturnCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileSetCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileStringCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileSwitchCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileUpvarCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileVariableCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclCompileWhileCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclInvertOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileInvertOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclNotOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileNotOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclAddOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileAddOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclMulOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileMulOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclAndOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileAndOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclOrOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileOrOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclXorOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileXorOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclPowOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompilePowOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclLshiftOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileLshiftOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclRshiftOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileRshiftOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclModOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileModOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclNeqOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileNeqOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclStrneqOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileStrneqOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclInOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileInOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclNiOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileNiOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclMinusOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileMinusOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclDivOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileDivOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclLessOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileLessOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclLeqOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileLeqOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclGreaterOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileGreaterOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclGeqOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileGeqOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclEqOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileEqOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
MODULE_SCOPE int TclStreqOpCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp,
- Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+ Tcl_Parse *parsePtr, Command *cmdPtr,
+ struct CompileEnv *envPtr);
/*
* Functions defined in generic/tclVar.c and currenttly exported only for use
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 5c6582d..7d9c2b4 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -23,7 +23,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclNamesp.c,v 1.154 2007/11/15 16:21:04 dkf Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.155 2007/11/16 14:11:52 dkf Exp $
*/
#include "tclInt.h"
@@ -109,8 +109,8 @@ typedef struct EnsembleConfig {
* all lists, and cannot be found by scanning
* the list from the namespace's ensemble
* field. */
- int flags; /* ORed combo of TCL_ENSEMBLE_PREFIX and
- * ENS_DEAD. */
+ int flags; /* ORed combo of TCL_ENSEMBLE_PREFIX, ENS_DEAD
+ * and ENSEMBLE_COMPILE. */
/* OBJECT FIELDS FOR ENSEMBLE CONFIGURATION */
@@ -5284,6 +5284,10 @@ Tcl_CreateEnsemble(
nsPtr->exportLookupEpoch++;
+ if (flags & ENSEMBLE_COMPILE) {
+ ((Command *) ensemblePtr->token)->compileProc = TclCompileEnsemble;
+ }
+
if (nameObj != NULL) {
TclDecrRefCount(nameObj);
}
@@ -5358,9 +5362,6 @@ Tcl_SetEnsembleSubcommandList(
if (cmdPtr->compileProc != NULL) {
((Interp *)interp)->compileEpoch++;
- if (subcmdList != NULL) {
- cmdPtr->compileProc = NULL;
- }
}
return TCL_OK;
@@ -5434,9 +5435,6 @@ Tcl_SetEnsembleMappingDict(
if (cmdPtr->compileProc != NULL) {
((Interp *)interp)->compileEpoch++;
- if (mapDict == NULL) {
- cmdPtr->compileProc = NULL;
- }
}
return TCL_OK;
@@ -5531,6 +5529,7 @@ Tcl_SetEnsembleFlags(
{
Command *cmdPtr = (Command *) token;
EnsembleConfig *ensemblePtr;
+ int wasCompiled;
if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
Tcl_AppendResult(interp, "command is not an ensemble", NULL);
@@ -5538,6 +5537,7 @@ Tcl_SetEnsembleFlags(
}
ensemblePtr = (EnsembleConfig *) cmdPtr->objClientData;
+ wasCompiled = ensemblePtr->flags & ENSEMBLE_COMPILE;
/*
* This API refuses to set the ENS_DEAD flag...
@@ -5555,6 +5555,24 @@ Tcl_SetEnsembleFlags(
ensemblePtr->nsPtr->exportLookupEpoch++;
+ /*
+ * If the ENSEMBLE_COMPILE flag status was changed, install or remove the
+ * compiler function and bump the interpreter's compilation epoch so that
+ * bytecode gets regenerated.
+ */
+
+ if (flags & ENSEMBLE_COMPILE) {
+ if (!wasCompiled) {
+ ((Command*) ensemblePtr->token)->compileProc = TclCompileEnsemble;
+ ((Interp *) interp)->compileEpoch++;
+ }
+ } else {
+ if (wasCompiled) {
+ ((Command*) ensemblePtr->token)->compileProc = NULL;
+ ((Interp *) interp)->compileEpoch++;
+ }
+ }
+
return TCL_OK;
}
diff --git a/tests/namespace.test b/tests/namespace.test
index 3ef1e35..5f7bdfb 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: namespace.test,v 1.68 2007/09/09 19:28:31 dgp Exp $
+# RCS: @(#) $Id: namespace.test,v 1.69 2007/11/16 14:11:53 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -174,7 +174,7 @@ test namespace-7.7 {Bug 1655305} -setup {
interp create slave
# Can't invoke through the ensemble, since deleting the global namespace
# (indirectly, via deleting ::tcl) deletes the ensemble.
- slave eval {rename ::tcl::Info_commands ::infocommands}
+ slave eval {rename ::tcl::info::commands ::infocommands}
slave hide infocommands
slave eval {
proc foo {} {
diff --git a/tests/trace.test b/tests/trace.test
index e172c03..bd3600f 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: trace.test,v 1.59 2007/08/14 15:17:51 dgp Exp $
+# RCS: @(#) $Id: trace.test,v 1.60 2007/11/16 14:11:53 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -2277,7 +2277,7 @@ test trace-29.1 {Tcl_CreateTrace, correct command and argc/argv arguments of tra
} {{expr 14 + 16} {expr 14 + 16} {set stuff [expr 14 + 16]} {set stuff 30}}
test trace-29.2 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
testcmdtrace tracetest {set stuff [info tclversion]}
-} [concat {{info tclversion} {info tclversion} ::tcl::Info_tclversion {::tcl::Info_tclversion} {set stuff [info tclversion]}} [list "set stuff [info tclversion]"]]
+} [concat {{info tclversion} {info tclversion} ::tcl::info::tclversion {::tcl::info::tclversion} {set stuff [info tclversion]}} [list "set stuff [info tclversion]"]]
test trace-29.3 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
testcmdtrace deletetest {set stuff [info tclversion]}
} [info tclversion]