diff options
author | dkf <dkf@noemail.net> | 2010-02-05 22:39:44 (GMT) |
---|---|---|
committer | dkf <dkf@noemail.net> | 2010-02-05 22:39:44 (GMT) |
commit | 0e0b2f9b4648e0420cbe73c125b22ac5aaa49980 (patch) | |
tree | 1ad7de865c4e74dc1bd2837830822c3c0b0c9e17 /generic/tclCompCmds.c | |
parent | 16100fde77c689bb94455ebf7026708590140758 (diff) | |
download | tcl-0e0b2f9b4648e0420cbe73c125b22ac5aaa49980.zip tcl-0e0b2f9b4648e0420cbe73c125b22ac5aaa49980.tar.gz tcl-0e0b2f9b4648e0420cbe73c125b22ac5aaa49980.tar.bz2 |
Added basic compilation of [error] (the most common case only).
FossilOrigin-Name: d3fc864505b95002aec20fa49a2ed613810211a1
Diffstat (limited to 'generic/tclCompCmds.c')
-rw-r--r-- | generic/tclCompCmds.c | 47 |
1 files changed, 46 insertions, 1 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 5455e5d..2b59d5c 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.158 2010/01/30 16:33:25 dkf Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.159 2010/02/05 22:39:44 dkf Exp $ */ #include "tclInt.h" @@ -1374,6 +1374,51 @@ PrintDictUpdateInfo( /* *---------------------------------------------------------------------- * + * TclCompileErrorCmd -- + * + * Procedure called to compile the "error" 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 "error" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileErrorCmd( + Tcl_Interp *interp, /* Used for context. */ + 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. */ +{ + /* + * General syntax: [error message ?errorInfo? ?errorCode?] + * However, we only deal with the case where there is just a message. + */ + Tcl_Token *messageTokenPtr; + DefineLineInformation; /* TIP #280 */ + + if (parsePtr->numWords != 2) { + return TCL_ERROR; + } + messageTokenPtr = TokenAfter(parsePtr->tokenPtr); + + PushLiteral(envPtr, "-code error -level 0", 20); + CompileWord(envPtr, messageTokenPtr, interp, 1); + TclEmitOpcode(INST_RETURN_STK, envPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TclCompileExprCmd -- * * Procedure called to compile the "expr" command. |