diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2012-10-26 07:32:47 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2012-10-26 07:32:47 (GMT) |
commit | ecb8fcec67eaa9ecc3902b669ad242dd76038562 (patch) | |
tree | adc7c064741a37afc892c059151bdb56e457191a /generic/tclCompCmds.c | |
parent | 8c9ab6bacf51046f3bb722ac655d9a3ddfd237d2 (diff) | |
download | tcl-ecb8fcec67eaa9ecc3902b669ad242dd76038562.zip tcl-ecb8fcec67eaa9ecc3902b669ad242dd76038562.tar.gz tcl-ecb8fcec67eaa9ecc3902b669ad242dd76038562.tar.bz2 |
Compile [namespace which -command]; big performance saving in some contexts.
Diffstat (limited to 'generic/tclCompCmds.c')
-rw-r--r-- | generic/tclCompCmds.c | 46 |
1 files changed, 46 insertions, 0 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 66bc5f0..245779e 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -4151,6 +4151,52 @@ TclCompileNamespaceUpvarCmd( PushLiteral(envPtr, "", 0); return TCL_OK; } + +int +TclCompileNamespaceWhichCmd( + 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 */ + Tcl_Token *tokenPtr, *opt; + int idx; + + if (parsePtr->numWords < 2 || parsePtr->numWords > 3) { + return TCL_ERROR; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + idx = 1; + + /* + * If there's an option, check that it's "-command". We don't handle + * "-variable" (currently) and anything else is an error. + */ + + if (parsePtr->numWords == 3) { + if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + return TCL_ERROR; + } + opt = tokenPtr + 1; + if (opt->size < 2 || opt->size > 8 + || strncmp(opt->start, "-command", opt->size) != 0) { + return TCL_ERROR; + } + tokenPtr = TokenAfter(tokenPtr); + idx++; + } + + /* + * Issue the bytecode. + */ + + CompileWord(envPtr, tokenPtr, interp, idx); + TclEmitOpcode( INST_RESOLVE_COMMAND, envPtr); + return TCL_OK; +} /* *---------------------------------------------------------------------- |