diff options
| -rw-r--r-- | ChangeLog | 11 | ||||
| -rw-r--r-- | generic/tclBasic.c | 4 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 47 | ||||
| -rw-r--r-- | generic/tclInt.h | 5 |
4 files changed, 60 insertions, 7 deletions
@@ -1,9 +1,14 @@ +2010-02-05 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclCompCmds.c (TclCompileErrorCmd): Added compilation of the + [error] command. No new bytecodes. + 2010-02-05 Jan Nijtmans <nijtmans@users.sf.net> * tools/genStubs.tcl: Follow-up to earlier commit today: - Eliminate the need for an extra Stubs Pointer - for adressing a static stub table: Just change - the exported table from static to MODULE_SCOPE. + Eliminate the need for an extra Stubs Pointer for adressing + a static stub table: Just change the exported table from + static to MODULE_SCOPE. * generic/tclBasic.c * generic/tclOO.c * generic/tclTomMathInterface.c diff --git a/generic/tclBasic.c b/generic/tclBasic.c index c2a8363..7eb8359 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.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: tclBasic.c,v 1.441 2010/02/05 20:53:12 nijtmans Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.442 2010/02/05 22:39:44 dkf Exp $ */ #include "tclInt.h" @@ -202,7 +202,7 @@ static const CmdInfo builtInCmds[] = { {"concat", Tcl_ConcatObjCmd, NULL, NULL, 1}, {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, 1}, {"coroutine", NULL, NULL, TclNRCoroutineObjCmd, 1}, - {"error", Tcl_ErrorObjCmd, NULL, NULL, 1}, + {"error", Tcl_ErrorObjCmd, TclCompileErrorCmd, NULL, 1}, {"eval", Tcl_EvalObjCmd, NULL, NULL, 1}, {"expr", Tcl_ExprObjCmd, TclCompileExprCmd, TclNRExprObjCmd, 1}, {"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, 1}, 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. diff --git a/generic/tclInt.h b/generic/tclInt.h index d08ed12..0e98299 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -15,7 +15,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.458 2010/02/05 10:03:23 nijtmans Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.459 2010/02/05 22:39:44 dkf Exp $ */ #ifndef _TCLINT @@ -3318,6 +3318,9 @@ MODULE_SCOPE int TclCompileDictUpdateCmd(Tcl_Interp *interp, MODULE_SCOPE int TclCompileEnsemble(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileErrorCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileExprCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); |