Move [throw] implementation into C.

3 files changed, 105 insertions, 3 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index d39f73f..3eab76a 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.381 2009/01/12 16:50:03 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.382 2009/01/13 20:30:03 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -208,6 +208,7 @@ static const CmdInfo builtInCmds[] = {
     {"split",		Tcl_SplitObjCmd,	NULL,			NULL,	1},
     {"subst",		Tcl_SubstObjCmd,	NULL,			NULL,	1},
     {"switch",		Tcl_SwitchObjCmd,	TclCompileSwitchCmd,	NULL,	1},
+    {"throw",		Tcl_ThrowObjCmd,	NULL,			NULL,	1},
     {"trace",		Tcl_TraceObjCmd,	NULL,			NULL,	1},
     {"unset",		Tcl_UnsetObjCmd,	NULL,			NULL,	1},
     {"uplevel",		Tcl_UplevelObjCmd,	NULL,			TclNRUplevelObjCmd,	1},
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index f5f6547..7cb14b5 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -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: tclCmdMZ.c,v 1.175 2009/01/09 11:21:45 dkf Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.176 2009/01/13 20:30:03 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -3911,6 +3911,66 @@ Tcl_SwitchObjCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_ThrowObjCmd --
+ *
+ *	This procedure is invoked to process the "throw" Tcl command. See the
+ *	user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+Tcl_ThrowObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Tcl_Obj *options;
+    int len;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "type message");
+	return TCL_ERROR;
+    }
+
+    /*
+     * The type must be a list of at least length 1.
+     */
+
+    if (Tcl_ListObjLength(interp, objv[1], &len) != TCL_OK) {
+	return TCL_ERROR;
+    } else if (len < 1) {
+	Tcl_AppendResult(interp, "type must be non-empty list", NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Now prepare the result options dictionary. We use the list API as it is
+     * slightly more convenient.
+     */
+
+    TclNewLiteralStringObj(options, "-code error -level 0 -errorcode");
+    Tcl_ListObjAppendElement(NULL, options, objv[1]);
+
+    /*
+     * We're ready to go. Fire things into the low-level result machinery.
+     */
+
+    Tcl_SetObjResult(interp, objv[2]);
+    return Tcl_SetReturnOptions(interp, options);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_TimeObjCmd --
  *
  *	This object-based procedure is invoked to process the "time" Tcl
@@ -4000,6 +4060,45 @@ Tcl_TimeObjCmd(
     return TCL_OK;
 }
 
+#if 0 /* not yet implemented */
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_TryObjCmd --
+ *
+ *	This procedure is invoked to process the "try" Tcl command. See the
+ *	user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl object result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_TryObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    return Tcl_NRCallObjProc(interp, TclNRTryObjCmd, dummy, objc, objv);    
+}
+
+int
+TclNRTryObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    
+}
+#endif /* not yet implemented */
+
 /*
  *----------------------------------------------------------------------
  *
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 67ba634..ee4fec7 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.412 2009/01/06 09:49:39 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.413 2009/01/13 20:30:03 dkf Exp $
  */
 
 #ifndef _TCLINT
@@ -3113,6 +3113,8 @@ MODULE_SCOPE int	Tcl_SwitchObjCmd(ClientData clientData,
 MODULE_SCOPE int	Tcl_TellObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
+MODULE_SCOPE int	Tcl_ThrowObjCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
 MODULE_SCOPE int	Tcl_TimeObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);