diff options
| -rw-r--r-- | ChangeLog | 14 | ||||
| -rw-r--r-- | generic/tclCmdIL.c | 70 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 355 | ||||
| -rw-r--r-- | generic/tclCompile.c | 7 | ||||
| -rw-r--r-- | generic/tclInt.h | 168 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 36 | ||||
| -rw-r--r-- | tests/namespace.test | 4 | ||||
| -rw-r--r-- | tests/trace.test | 4 |
8 files changed, 487 insertions, 171 deletions
@@ -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] |