summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2010-02-05 22:39:44 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2010-02-05 22:39:44 (GMT)
commita7d5e487cdc90cf70ddff97143b7357800b9388d (patch)
tree1ad7de865c4e74dc1bd2837830822c3c0b0c9e17
parent9f80e538be5be980c7e52789ff2162b08db46823 (diff)
downloadtcl-a7d5e487cdc90cf70ddff97143b7357800b9388d.zip
tcl-a7d5e487cdc90cf70ddff97143b7357800b9388d.tar.gz
tcl-a7d5e487cdc90cf70ddff97143b7357800b9388d.tar.bz2
Added basic compilation of [error] (the most common case only).
-rw-r--r--ChangeLog11
-rw-r--r--generic/tclBasic.c4
-rw-r--r--generic/tclCompCmds.c47
-rw-r--r--generic/tclInt.h5
4 files changed, 60 insertions, 7 deletions
diff --git a/ChangeLog b/ChangeLog
index 78963fe..045d394 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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);