Added Tcl_CreateObjTrace, Tcl_GetCommandInfoFromToken and

Tcl_SetCommandInfoFromToken. (TIPs #32 and #79.)

11 files changed, 724 insertions, 148 deletions

diff --git a/ChangeLog b/ChangeLog
index 8d5cf9c..cb62129 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,19 @@
+2002-02-10  Kevin Kenny  <kennykb@acm.org>
+
+	* doc/CrtObjCmd.3:
+	* doc/CrtTrace.3:
+	* generic/tcl.decls:
+	* generic/tcl.h:
+	* generic/tclBasic.c:
+	* generic/tclInt.h:
+	* generic/tclTest.c:
+	* tests/basic.test: Added Tcl_CreateObjTrace,
+	Tcl_GetCommandInfoFromToken and Tcl_SetCommandInfoFromToken.
+	(TIPs #32 and #79.)
+
+	* generic/tclDecls.h:
+	* generic/tclStubInit.c: Regenerated Stubs tables.
+	
 2002-02-08  Jeff Hobbs  <jeffh@ActiveState.com>
 
 	* unix/configure:
diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3
index 838cbbe..b1dc890 100644
--- a/doc/CrtObjCmd.3
+++ b/doc/CrtObjCmd.3
@@ -4,13 +4,13 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: CrtObjCmd.3,v 1.5 2001/04/24 20:59:17 kennykb Exp $
+'\" RCS: @(#) $Id: CrtObjCmd.3,v 1.6 2002/02/10 20:36:33 kennykb Exp $
 '\" 
 .so man.macros
 .TH Tcl_CreateObjCommand 3 8.0 Tcl "Tcl Library Procedures"
 .BS
 .SH NAME
-Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_SetCommandInfo, Tcl_GetCommandName \- implement new commands in C
+Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName \- implement new commands in C
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
@@ -31,6 +31,14 @@ int
 \fBTcl_SetCommandInfo\fR(\fIinterp, cmdName, infoPtr\fR)
 .sp
 .VS 8.4
+int
+\fBTcl_GetCommandInfoFromToken\fR(\fItoken, infoPtr\fR)
+.sp
+int
+\fBTcl_SetCommandInfoFromToken\fR(\fItoken, infoPtr\fR)
+.VE
+.sp
+.VS 8.4
 CONST char *
 .VE
 \fBTcl_GetCommandName\fR(\fIinterp, token\fR)
@@ -230,6 +238,12 @@ to pass to \fIdeleteProc\fR;  it is normally the same as
 The field \fInamespacePtr\fR holds a pointer to the
 Tcl_Namespace that contains the command.
 .PP
+\fBTcl_GetCommandInfoFromToken\fR is identical to
+\fBTcl_GetCommandInfo\fR except that it uses a command token returned
+from \fBTcl_CreateObjCommand\fR in place of the command name.  If the
+\fItoken\fR parameter is NULL, it returns 0; otherwise, it returns 1
+and fills in the structure designated by \fIinfoPtr\fR.
+.PP
 \fBTcl_SetCommandInfo\fR is used to modify the procedures and
 ClientData values associated with a command.
 Its \fIcmdName\fR argument is the name of a command in \fIinterp\fR.
@@ -238,11 +252,22 @@ to identify a command in a particular namespace.
 If this command does not exist then \fBTcl_SetCommandInfo\fR returns 0.
 Otherwise, it copies the information from \fI*infoPtr\fR to
 Tcl's internal structure for the command and returns 1.
-Note that this procedure allows the ClientData for a command's
-deletion procedure to be given a different value than the ClientData
-for its command procedure.
-Note that \fBTcl_SetCmdInfo\fR will not change a command's namespace;
-you must use \fBTcl_RenameCommand\fR to do that.
+.PP
+\fBTcl_SetCommandInfoFromToken\fR is identical to
+\fBTcl_SetCommandInfo\fR except that it takes a command token as
+returned by \fBTcl_CreateObjCommand\fR instead of the command name.
+If the \fItoken\fR parameter is NULL, it returns 0.  Otherwise, it
+copies the information from \fI*infoPtr\fR to Tcl's internal structure
+for the command and returns 1.
+.PP
+Note that \fBTcl_SetCommandInfo\fR and
+\fBTcl_SetCommandInfoFromToken\fR both allow the ClientData for a
+command's deletion procedure to be given a different value than the
+ClientData for its command procedure.
+.PP
+Note that neither \fBTcl_SetCommandInfo\fR nor
+\fBTcl_SetCommandInfoFromToken\fR will change a command's namespace.
+You must use \fBTcl_RenameCommand\fR to do that.
 .PP
 \fBTcl_GetCommandName\fR provides a mechanism for tracking commands
 that have been renamed.
diff --git a/doc/CrtTrace.3 b/doc/CrtTrace.3
index dff97d1..0b10d98 100644
--- a/doc/CrtTrace.3
+++ b/doc/CrtTrace.3
@@ -1,17 +1,18 @@
 '\"
 '\" Copyright (c) 1989-1993 The Regents of the University of California.
 '\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\" Copyright (c) 2002 by Kevin B. Kenny.  All rights reserved.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: CrtTrace.3,v 1.2 1998/09/14 18:39:47 stanton Exp $
+'\" RCS: @(#) $Id: CrtTrace.3,v 1.3 2002/02/10 20:36:33 kennykb Exp $
 '\" 
 .so man.macros
 .TH Tcl_CreateTrace 3 "" Tcl "Tcl Library Procedures"
 .BS
 .SH NAME
-Tcl_CreateTrace, Tcl_DeleteTrace \- arrange for command execution to be traced
+Tcl_CreateTrace, Tcl_CreateObjTrace, Tcl_DeleteTrace \- arrange for command execution to be traced
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
@@ -19,9 +20,12 @@ Tcl_CreateTrace, Tcl_DeleteTrace \- arrange for command execution to be traced
 Tcl_Trace
 \fBTcl_CreateTrace\fR(\fIinterp, level, proc, clientData\fR)
 .sp
+Tcl_Trace
+\fBTcl_CreateObjTrace\fR(\fIinterp, level, flags, objProc, clientData, deleteProc\fR)
+.sp
 \fBTcl_DeleteTrace\fR(\fIinterp, trace\fR)
 .SH ARGUMENTS
-.AS Tcl_CmdTraceProc (clientData)()
+.AS Tcl_CmdObjTraceDeleteProc (clientData)()
 .AP Tcl_Interp *interp in
 Interpreter containing command to be traced or untraced.
 .AP int level in
@@ -29,63 +33,94 @@ Only commands at or below this nesting level will be traced.  1 means
 top-level commands only, 2 means top-level commands or those that are
 invoked as immediate consequences of executing top-level commands
 (procedure bodies, bracketed commands, etc.) and so on.
+.AP int flags in
+Flags governing the trace execution.  See below for details.
+.AP Tcl_CmdObjTraceProc *proc in
+Procedure to call for each command that's executed.  See below for
+details of the calling sequence.
 .AP Tcl_CmdTraceProc *proc in
 Procedure to call for each command that's executed.  See below for
 details on the calling sequence.
 .AP ClientData clientData in
-Arbitrary one-word value to pass to \fIproc\fR.
+Arbitrary one-word value to pass to \fIobjProc\fR or \fIproc\fR.
+.AP Tcl_CmdObjTraceDeleteProc *deleteProc
+Procedure to call when the trace is deleted.  See below for details of
+the calling sequence.  A null pointer is permissible and results in no
+callback when the trace is deleted.
 .AP Tcl_Trace trace in
 Token for trace to be removed (return value from previous call
 to \fBTcl_CreateTrace\fR).
 .BE
-
 .SH DESCRIPTION
 .PP
-\fBTcl_CreateTrace\fR arranges for command tracing.  From now on, \fIproc\fR
-will be invoked before Tcl calls command procedures to process
-commands in \fIinterp\fR.  The return value from
-\fBTcl_CreateTrace\fR is a token for the trace,
-which may be passed to \fBTcl_DeleteTrace\fR to remove the trace.  There may
-be many traces in effect simultaneously for the same command interpreter.
+\fBTcl_CreateObjTrace\fR arranges for command tracing.  After it is
+called, \fIobjProc\fR will be invoked before the Tcl interpreter calls
+any command procedure when evaluating commands in \fIinterp\fR.
+The return value from \fBTcl_CreateObjTrace\fR is a token for the trace,
+which may be passed to \fBTcl_DeleteTrace\fR to remove the trace.
+There may be many traces in effect simultaneously for the same
+interpreter.
 .PP
-\fIProc\fR should have arguments and result that match the
-type \fBTcl_CmdTraceProc\fR:
+\fIobjProc\fR should have arguments and result that match the type,
+\fBTcl_CmdObjTraceProc\fR:
 .CS
-typedef void Tcl_CmdTraceProc(
-	ClientData \fIclientData\fR,
-	Tcl_Interp *\fIinterp\fR,
-	int \fIlevel\fR,
-	char *\fIcommand\fR,
-	Tcl_CmdProc *\fIcmdProc\fR,
-	ClientData \fIcmdClientData\fR,
-	int \fIargc\fR,
-	char *\fIargv\fR[]);
+typedef int \fBTcl_CmdObjTraceProc\fR( 
+    \fBClientData\fR \fIclientData\fR,
+    \fBTcl_Interp\fR* \fIinterp\fR,
+    int \fIlevel\fR,
+    CONST char* \fIcommand\fR,
+    \fBTcl_Command\fR \fIcommandToken\fR,
+    int \fIobjc\fR,
+    \fBTcl_Obj\fR *CONST \fIobjv\fR[] );
 .CE
-The \fIclientData\fR and \fIinterp\fR parameters are
-copies of the corresponding arguments given to \fBTcl_CreateTrace\fR.
-\fIClientData\fR typically points to an application-specific
-data structure that describes what to do when \fIproc\fR
-is invoked.  \fILevel\fR gives the nesting level of the command
-(1 for top-level commands passed to \fBTcl_Eval\fR by the application,
-2 for the next-level commands passed to \fBTcl_Eval\fR as part of parsing
-or interpreting level-1 commands, and so on).  \fICommand\fR
-points to a string containing the text of the
-command, before any argument substitution.
-\fICmdProc\fR contains the address of the command procedure that
-will be called to process the command (i.e. the \fIproc\fR argument
-of some previous call to \fBTcl_CreateCommand\fR) and \fIcmdClientData\fR
-contains the associated client data for \fIcmdProc\fR (the \fIclientData\fR
-value passed to \fBTcl_CreateCommand\fR).  \fIArgc\fR and \fIargv\fR give
-the final argument information that will be passed to \fIcmdProc\fR, after
-command, variable, and backslash substitution.
-\fIProc\fR must not modify the \fIcommand\fR or \fIargv\fR strings.
+The \fIclientData\fR and \fIinterp\fR parameters are copies of the
+corresponding arguments given to \fBTcl_CreateTrace\fR.
+\fIClientData\fR typically points to an application-specific data
+structure that describes what to do when \fIobjProc\fR is invoked.  The
+\fIlevel\fR parameter gives the nesting level of the command (1 for
+top-level commands passed to \fBTcl_Eval\fR by the application, 2 for
+the next-level commands passed to \fBTcl_Eval\fR as part of parsing or
+interpreting level-1 commands, and so on). The \fIcommand\fR parameter
+points to a string containing the text of the command, before any
+argument substitution.  The \fIcommandToken\fR parameter is a Tcl
+command token that identifies the command to be invoked.  The token
+may be passed to \fBTcl_GetCommandName\fR,
+\fBTcl_GetCommandTokenInfo\fR, or \fBTcl_SetCommandTokenInfo\fR to
+manipulate the definition of the command. The \fIobjc\fR and \fIobjv\fR
+parameters designate the final parameter count and parameter vector
+that will be passed to the command, and have had all substitutions
+performed.
+.PP
+The \fIobjProc\fR callback is expected to return a standard Tcl status
+return code.  If this code is \fBTCL_OK\fR (the normal case), then
+the Tcl interpreter will invoke the command.  Any other return code
+is treated as if the command returned that status, and the command is
+\fInot\fR invoked.
+.PP
+The \fIobjProc\fR callback must not modify \fIobjv\fR in any way.  It
+is, however, permissible to change the command by calling
+\fBTcl_SetCommandTokenInfo\fR prior to returning.  Any such change
+takes effect immediately, and the command is invoked with the new
+information.
 .PP
 Tracing will only occur for commands at nesting level less than
 or equal to the \fIlevel\fR parameter (i.e. the \fIlevel\fR
-parameter to \fIproc\fR will always be less than or equal to the
+parameter to \fIobjProc\fR will always be less than or equal to the
 \fIlevel\fR parameter to \fBTcl_CreateTrace\fR).
 .PP
-Calls to \fIproc\fR will be made by the Tcl parser immediately before
+Tracing has a significant effect on runtime performance because it
+causes the bytecode compiler to refrain from generating in-line code
+for Tcl commands such as \fBif\fR and \fBwhile\fR in order that they
+may be traced.  If traces for the built-in commands are not required,
+the \fIflags\fR parameter may be set to the constant value
+\fBTCL_ALLOW_INLINE_COMPILATION\fR.  In this case, traces on built-in
+commands may or may not result in trace callbacks, depending on the
+state of the interpreter, but run-time performance will be improved
+significantly.  (This functionality is desirable, for example, when
+using \fBTcl_CreateObjTrace\fR to implement an execution time
+profiler.)
+.PP
+Calls to \fIobjProc\fR will be made by the Tcl parser immediately before
 it calls the command procedure for the command (\fIcmdProc\fR).  This
 occurs after argument parsing and substitution, so tracing for
 substituted commands occurs before tracing of the commands
@@ -93,14 +128,59 @@ containing the substitutions.  If there is a syntax error in a
 command, or if there is no command procedure associated with a
 command name, then no tracing will occur for that command.  If a
 string passed to Tcl_Eval contains multiple commands (bracketed, or
-on different lines) then multiple calls to \fIproc\fR will occur,
-one for each command.  The \fIcommand\fR string for each of these
-trace calls will reflect only a single command, not the entire string
-passed to Tcl_Eval.
+on different lines) then multiple calls to \fIobjProc\fR will occur,
+one for each command.
 .PP
 \fBTcl_DeleteTrace\fR removes a trace, so that no future calls will be
 made to the procedure associated with the trace.  After \fBTcl_DeleteTrace\fR
 returns, the caller should never again use the \fItrace\fR token.
-
+.PP
+When \fBTcl_DeleteTrace\fR is called, the interpreter invokes the
+\fIdeleteProc\fR that was passed as a parameter to
+\fBTcl_CreateObjTrace\fR.  The \fIdeleteProc\fR must match the type,
+\fBTcl_CmdObjTraceDeleteProc\fR:
+.CS
+typedef void \fBTcl_CmdObjTraceDeleteProc\fR( 
+    \fBClientData\fR \fIclientData\fR
+);
+.CE
+The \fIclientData\fR parameter will be the same as the
+\fIclientData\fR parameter that was originally passed to
+\fBTcl_CreateObjTrace\fR.
+.PP
+\fBTcl_CreateTrace\fR is an alternative interface for command tracing,
+\fInot recommended for new applications\fR.  It is provided for backward
+compatibility with code that was developed for older versions of the
+Tcl interpreter.  It is similar to \fBTcl_CreateObjTrace\fR, except
+that its \fIproc\fR parameter should have arguments and result that
+match the type \fBTcl_CmdTraceProc\fR:
+.CS
+typedef void Tcl_CmdTraceProc(
+	ClientData \fIclientData\fR,
+	Tcl_Interp *\fIinterp\fR,
+	int \fIlevel\fR,
+	char *\fIcommand\fR,
+	Tcl_CmdProc *\fIcmdProc\fR,
+	ClientData \fIcmdClientData\fR,
+	int \fIargc\fR,
+	char *\fIargv\fR[]);
+.CE
+The parameters to the \fIproc\fR callback are similar to those of the
+\fIobjProc\fR callback above. The \fIcommandToken\fR is
+replaced with \fIcmdProc\fR, a pointer to the (string-based) command
+procedure that will be invoked; and \fIcmdClientData\fR, the client
+data that will be passed to the procedure.  The \fIobjc\fR parameter
+is replaced with an \fIargv\fR parameter, that gives the arguments to
+the command as character strings.
+\fIProc\fR must not modify the \fIcommand\fR or \fIargv\fR strings.
+.PP
+If a trace created with \fBTcl_CreateTrace\fR is in effect, inline
+compilation of Tcl commands such as \fBif\fR and \fBwhile\fR is always
+disabled.  There is no notification when a trace created with
+\fBTcl_CreateTrace\fR is deleted.
+There is no way to be notified when the trace created by
+\fBTcl_CreateTrace\fR is deleted.  There is no way for the \fIproc\fR
+associated with a call to \fBTcl_CreateTrace\fR to abort execution of
+\fIcommand\fR.
 .SH KEYWORDS
 command, create, delete, interpreter, trace
diff --git a/generic/tcl.decls b/generic/tcl.decls
index c17195f..9e6e3b4 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -7,10 +7,11 @@
 #	
 #
 # Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # 
-# RCS: @(#) $Id: tcl.decls,v 1.81 2002/02/08 02:52:54 dgp Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.82 2002/02/10 20:36:33 kennykb Exp $
 
 library tcl
 
@@ -801,7 +802,7 @@ declare 225 generic {
 }
 declare 226 generic {
     int Tcl_SetCommandInfo(Tcl_Interp *interp, CONST char *cmdName, \
-	    Tcl_CmdInfo *infoPtr)
+	    CONST Tcl_CmdInfo *infoPtr)
 }
 declare 227 generic {
     void Tcl_SetErrno(int err)
@@ -1700,6 +1701,25 @@ declare 482 generic {
     void Tcl_GetTime( Tcl_Time* timeBuf )
 }
 
+# New exports due to TIP#32
+
+declare 483 generic {
+    Tcl_Trace Tcl_CreateObjTrace( Tcl_Interp* interp,
+             	                  int level,
+	                          int flags,
+                                  Tcl_CmdObjTraceProc* objProc,
+                                  ClientData clientData,
+			          Tcl_CmdObjTraceDeleteProc* delProc )
+}
+declare 484 generic {
+    int Tcl_GetCommandInfoFromToken( Tcl_Command token,
+	                             Tcl_CmdInfo* infoPtr )
+}
+declare 485 generic {
+    int Tcl_SetCommandInfoFromToken( Tcl_Command token,
+	                             CONST Tcl_CmdInfo* infoPtr )
+}
+
 ##############################################################################
 
 # Define the platform specific public Tcl interface.  These functions are
diff --git a/generic/tcl.h b/generic/tcl.h
index b95e9a8..d9526b7 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -8,11 +8,12 @@
  * Copyright (c) 1993-1996 Lucent Technologies.
  * Copyright (c) 1994-1998 Sun Microsystems, Inc.
  * Copyright (c) 1998-2000 by Scriptics Corporation.
+ * Copyright (c) 2002 by Kevin B. Kenny.  All rights reserved.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tcl.h,v 1.113 2002/02/08 02:52:54 dgp Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.114 2002/02/10 20:36:34 kennykb Exp $
  */
 
 #ifndef _TCL
@@ -580,6 +581,15 @@ typedef int (Tcl_CmdProc) _ANSI_ARGS_((ClientData clientData,
 typedef void (Tcl_CmdTraceProc) _ANSI_ARGS_((ClientData clientData,
 	Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc,
 	ClientData cmdClientData, int argc, char *argv[]));
+typedef int (Tcl_CmdObjTraceProc) _ANSI_ARGS_(( 
+    ClientData            clientData,
+    Tcl_Interp*           interp,
+    int                   level,
+    CONST char*           command,
+    Tcl_Command           commandInfo,
+    int                   objc,
+    struct Tcl_Obj *CONST objv[] ));
+typedef void (Tcl_CmdObjTraceDeleteProc) _ANSI_ARGS_((ClientData clientData));
 typedef void (Tcl_DupInternalRepProc) _ANSI_ARGS_((struct Tcl_Obj *srcPtr, 
         struct Tcl_Obj *dupPtr));
 typedef int (Tcl_EncodingConvertProc)_ANSI_ARGS_((ClientData clientData,
@@ -959,6 +969,8 @@ typedef struct Tcl_DString {
 #define TCL_TRACE_RENAME 0x2000
 #define TCL_TRACE_DELETE 0x4000
 
+#define TCL_ALLOW_INLINE_COMPILATION 0x20000
+
 /*
  * The TCL_PARSE_PART1 flag is deprecated and has no effect. 
  * The part1 is now always parsed whenever the part2 is NULL.
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 133228a..d9765a0 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -8,12 +8,12 @@
  * Copyright (c) 1987-1994 The Regents of the University of California.
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  * Copyright (c) 1998-1999 by Scriptics Corporation.
- * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
+ * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
  *
  * 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.45 2002/01/29 02:40:49 hobbs Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.46 2002/02/10 20:36:34 kennykb Exp $
  */
 
 #include "tclInt.h"
@@ -32,6 +32,14 @@ static char *		CallCommandTraces _ANSI_ARGS_((Interp *iPtr,
 static void		DeleteInterpProc _ANSI_ARGS_((Tcl_Interp *interp));
 static void		ProcessUnexpectedResult _ANSI_ARGS_((
 			    Tcl_Interp *interp, int returnCode));
+static int	        StringTraceProc _ANSI_ARGS_((ClientData clientData,
+						     Tcl_Interp* interp,
+						     int level,
+						     CONST char* command,
+						    Tcl_Command commandInfo,
+						    int objc,
+						    Tcl_Obj *CONST objv[]));
+static void           StringTraceDeleteProc _ANSI_ARGS_((ClientData clientData));
 
 extern TclStubs tclStubs;
 
@@ -242,6 +250,15 @@ static CmdInfo builtInCmds[] = {
         (CompileProc *) NULL,		0}
 };
 
+/*
+ * The following structure holds the client data for string-based
+ * trace procs
+ */
+
+typedef struct StringTraceData {
+    ClientData clientData;	/* Client data from Tcl_CreateTrace */
+    Tcl_CmdTraceProc* proc;	/* Trace procedure from Tcl_CreateTrace */
+} StringTraceData;
 
 /*
  *----------------------------------------------------------------------
@@ -338,6 +355,7 @@ Tcl_CreateInterp()
     iPtr->scriptFile = NULL;
     iPtr->flags = 0;
     iPtr->tracePtr = NULL;
+    iPtr->tracesForbiddingInline = 0;
     iPtr->activeCmdTracePtr = NULL;
     iPtr->assocData = (Tcl_HashTable *) NULL;
     iPtr->execEnvPtr = NULL;	      /* set after namespaces initialized */
@@ -1053,10 +1071,7 @@ DeleteInterpProc(interp)
     }
     TclFreePackageInfo(iPtr);
     while (iPtr->tracePtr != NULL) {
-	Trace *nextPtr = iPtr->tracePtr->nextPtr;
-
-	ckfree((char *) iPtr->tracePtr);
-	iPtr->tracePtr = nextPtr;
+	Tcl_DeleteTrace( (Tcl_Interp*) iPtr, (Tcl_Trace) iPtr->tracePtr );
     }
     if (iPtr->execEnvPtr != NULL) {
 	TclDeleteExecEnv(iPtr->execEnvPtr);
@@ -2034,14 +2049,47 @@ Tcl_SetCommandInfo(interp, cmdName, infoPtr)
     Tcl_Interp *interp;			/* Interpreter in which to look
 					 * for command. */
     CONST char *cmdName;		/* Name of desired command. */
-    Tcl_CmdInfo *infoPtr;		/* Where to find information
+    CONST Tcl_CmdInfo *infoPtr;		/* Where to find information
 					 * to store in the command. */
 {
     Tcl_Command cmd;
-    Command *cmdPtr;
 
     cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
             /*flags*/ 0);
+
+    return Tcl_SetCommandInfoFromToken( cmd, infoPtr );
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetCommandInfoFromToken --
+ *
+ *	Modifies various information about a Tcl command. Note that
+ *	this procedure will not change a command's namespace; use
+ *	Tcl_RenameCommand to do that. Also, the isNativeObjectProc
+ *	member of *infoPtr is ignored.
+ *
+ * Results:
+ *	If cmdName exists in interp, then the information at *infoPtr
+ *	is stored with the command in place of the current information
+ *	and 1 is returned. If the command doesn't exist then 0 is
+ *	returned. 
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetCommandInfoFromToken( cmd, infoPtr )
+    Tcl_Command cmd;
+    CONST Tcl_CmdInfo* infoPtr;
+{
+    Command* cmdPtr;		/* Internal representation of the command */
+
     if (cmd == (Tcl_Command) NULL) {
 	return 0;
     }
@@ -2093,11 +2141,41 @@ Tcl_GetCommandInfo(interp, cmdName, infoPtr)
 					 * command. */
 {
     Tcl_Command cmd;
-    Command *cmdPtr;
 
     cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
             /*flags*/ 0);
-    if (cmd == (Tcl_Command) NULL) {
+
+    return Tcl_GetCommandInfoFromToken( cmd, infoPtr );
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCommandInfoFromToken --
+ *
+ *	Returns various information about a Tcl command.
+ *
+ * Results:
+ *	Copies information from the command identified by 'cmd' into
+ *	a caller-supplied structure and returns 1.  If the 'cmd' is
+ *	NULL, leaves the structure untouched and returns 0.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetCommandInfoFromToken( cmd, infoPtr )
+    Tcl_Command cmd;
+    Tcl_CmdInfo* infoPtr;
+{
+
+    Command* cmdPtr;		/* Internal representation of the command */
+
+    if ( cmd == (Tcl_Command) NULL ) {
 	return 0;
     }
 
@@ -2116,7 +2194,9 @@ Tcl_GetCommandInfo(interp, cmdName, infoPtr)
     infoPtr->deleteProc = cmdPtr->deleteProc;
     infoPtr->deleteData = cmdPtr->deleteData;
     infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr;
+
     return 1;
+
 }
 
 /*
@@ -2832,11 +2912,12 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
     Command *cmdPtr;
     Interp *iPtr = (Interp *) interp;
     Tcl_Obj **newObjv;
-    int i, code;
+    int i;
     Trace *tracePtr, *nextPtr;
-    char **argv, *commandCopy;
+    char *commandCopy;
     CallFrame *savedVarFramePtr;	/* Saves old copy of iPtr->varFramePtr
 					 * in case TCL_EVAL_GLOBAL was set. */
+    int code = TCL_OK;
 
     if (objc == 0) {
 	return TCL_OK;
@@ -2881,46 +2962,56 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
      * Call trace procedures if needed.
      */
 
-    if (command != NULL) {
-	argv = NULL;
+    if ( command != NULL && iPtr->tracePtr != NULL ) {
 	commandCopy = command;
 
-	for (tracePtr = iPtr->tracePtr; tracePtr != NULL; tracePtr = nextPtr) {
+	/* 
+	 * Make a copy of the command if necessary, so that trace
+	 * procs will see it.
+	 */
+
+	if (length < 0) {
+	    length = strlen(command);
+	} else if ((size_t)length < strlen(command)) {
+	    commandCopy = (char *) ckalloc((unsigned) (length + 1));
+	    strncpy(commandCopy, command, (size_t) length);
+	    commandCopy[length] = 0;
+	}
+
+	/*
+	 * Walk through the trace procs
+	 */
+
+	for ( tracePtr = iPtr->tracePtr;
+	      (code == TCL_OK) && (tracePtr != NULL);
+	      tracePtr = nextPtr) {
 	    nextPtr = tracePtr->nextPtr;
 	    if (iPtr->numLevels > tracePtr->level) {
 		continue;
 	    }
 
 	    /*
-	     * This is a bit messy because we have to emulate the old trace
-	     * interface, which uses strings for everything.
+	     * Invoke one trace proc
 	     */
-	    
-	    if (argv == NULL) {
-		argv = (char **) ckalloc((unsigned) (objc + 1) * sizeof(char *));
-		for (i = 0; i < objc; i++) {
-		    argv[i] = Tcl_GetString(objv[i]);
-		}
-		argv[objc] = 0;
-		
-		if (length < 0) {
-		    length = strlen(command);
-		} else if ((size_t)length < strlen(command)) {
-		    commandCopy = (char *) ckalloc((unsigned) (length + 1));
-		    strncpy(commandCopy, command, (size_t) length);
-		    commandCopy[length] = 0;
-		}
-	    }
-	    (*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels,
-			  commandCopy, cmdPtr->proc, cmdPtr->clientData,
-			  objc, argv);
-	}
-	if (argv != NULL) {
-	    ckfree((char *) argv);
+
+	    code = (tracePtr->proc)( tracePtr->clientData,
+				     (Tcl_Interp*) iPtr,
+				     iPtr->numLevels,
+				     commandCopy,
+				     (Tcl_Command) cmdPtr,
+				     objc,
+				     objv );
 	}
+	
+	/*
+	 * If we had to copy the command for the trace procs, free the
+	 * copy.
+	 */
+
 	if (commandCopy != command) {
 	    ckfree((char *) commandCopy);
 	}
+
     }
     
     /*
@@ -2928,12 +3019,14 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
      */
     
     iPtr->cmdCount++;
-    savedVarFramePtr = iPtr->varFramePtr;
-    if (flags & TCL_EVAL_GLOBAL) {
-	iPtr->varFramePtr = NULL;
+    if ( code == TCL_OK ) {
+	savedVarFramePtr = iPtr->varFramePtr;
+	if (flags & TCL_EVAL_GLOBAL) {
+	    iPtr->varFramePtr = NULL;
+	}
+	code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
+	iPtr->varFramePtr = savedVarFramePtr;
     }
-    code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
-    iPtr->varFramePtr = savedVarFramePtr;
     if (Tcl_AsyncReady()) {
 	code = Tcl_AsyncInvoke(interp, code);
     }
@@ -4517,6 +4610,114 @@ Tcl_ExprString(interp, string)
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_CreateObjTrace --
+ *
+ *	Arrange for a procedure to be called to trace command execution.
+ *
+ * Results:
+ *	The return value is a token for the trace, which may be passed
+ *	to Tcl_DeleteTrace to eliminate the trace.
+ *
+ * Side effects:
+ *	From now on, proc will be called just before a command procedure
+ *	is called to execute a Tcl command.  Calls to proc will have the
+ *	following form:
+ *
+ *      void proc( ClientData     clientData,
+ *                 Tcl_Interp*    interp,
+ *                 int            level,
+ *                 CONST char*    command,
+ *                 Tcl_Command    commandInfo,
+ *                 int            objc,
+ *                 Tcl_Obj *CONST objv[] );
+ *
+ *      The 'clientData' and 'interp' arguments to 'proc' will be the
+ *      same as the arguments to Tcl_CreateObjTrace.  The 'level'
+ *	argument gives the nesting depth of command interpretation within
+ *	the interpreter.  The 'command' argument is the ASCII text of
+ *	the command being evaluated -- before any substitutions are
+ *	performed.  The 'commandInfo' argument gives a handle to the
+ *	command procedure that will be evaluated.  The 'objc' and 'objv'
+ *	parameters give the parameter vector that will be passed to the
+ *	command procedure.  proc does not return a value.
+ *
+ *      It is permissible for 'proc' to call Tcl_SetCommandTokenInfo
+ *      to change the command procedure or client data for the command
+ *      being evaluated, and these changes will take effect with the
+ *      current evaluation.
+ *
+ * The 'level' argument specifies the maximum nesting level of calls
+ * to be traced.  If the execution depth of the interpreter exceeds
+ * 'level', the trace callback is not executed.
+ *
+ * The 'flags' argument is either zero or the value,
+ * TCL_ALLOW_INLINE_COMPILATION.  If the TCL_ALLOW_INLINE_COMPILATION
+ * flag is not present, the bytecode compiler will not generate inline
+ * code for Tcl's built-in commands.  This behavior will have a significant
+ * impact on performance, but will ensure that all command evaluations are
+ * traced.  If the TCL_ALLOW_INLINE_COMPILATION flag is present, the
+ * bytecode compiler will have its normal behavior of compiling in-line
+ * code for some of Tcl's built-in commands.  In this case, the tracing
+ * will be imprecise -- in-line code will not be traced -- but run-time
+ * performance will be improved.  The latter behavior is desired for
+ * many applications such as profiling of run time.
+ *
+ * When the trace is deleted, the 'delProc' procedure will be invoked,
+ * passing it the original client data.  
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Trace
+Tcl_CreateObjTrace( interp, level, flags, proc, clientData, delProc )
+    Tcl_Interp* interp;		/* Tcl interpreter */
+    int level;			/* Maximum nesting level */
+    int flags;			/* Flags, see above */
+    Tcl_CmdObjTraceProc* proc;	/* Trace callback */
+    ClientData clientData;	/* Client data for the callback */
+    Tcl_CmdObjTraceDeleteProc* delProc;
+				/* Procedure to call when trace is deleted */
+{
+    register Trace *tracePtr;
+    register Interp *iPtr = (Interp *) interp;
+
+    /* Test if this trace allows inline compilation of commands */
+
+    if ( ! ( flags & TCL_ALLOW_INLINE_COMPILATION ) ) {
+
+	if ( iPtr->tracesForbiddingInline == 0 ) {
+
+	    /*
+	     * When the first trace forbidding inline compilation is
+	     * created, invalidate existing compiled code for this
+	     * interpreter and arrange (by setting the
+	     * DONT_COMPILE_CMDS_INLINE flag) that when compiling new
+	     * code, no commands will be compiled inline (i.e., into
+	     * an inline sequence of instructions). We do this because
+	     * commands that were compiled inline will never result in
+	     * a command trace being called.
+	     */
+
+	    iPtr->compileEpoch++;
+	    iPtr->flags |= DONT_COMPILE_CMDS_INLINE;
+	}
+	++ iPtr->tracesForbiddingInline;
+    }
+    
+    tracePtr = (Trace *) ckalloc(sizeof(Trace));
+    tracePtr->level		= level;
+    tracePtr->proc		= proc;
+    tracePtr->clientData	= clientData;
+    tracePtr->delProc           = delProc;
+    tracePtr->nextPtr		= iPtr->tracePtr;
+    iPtr->tracePtr		= tracePtr;
+
+    return (Tcl_Trace) tracePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_CreateTrace --
  *
  *	Arrange for a procedure to be called to trace command execution.
@@ -4566,28 +4767,98 @@ Tcl_CreateTrace(interp, level, proc, clientData)
 				 * command. */
     ClientData clientData;	/* Arbitrary value word to pass to proc. */
 {
-    register Trace *tracePtr;
-    register Interp *iPtr = (Interp *) interp;
+    
+    StringTraceData* data;
+    data = (StringTraceData*) ckalloc( sizeof( *data ));
+    data->clientData = clientData;
+    data->proc = proc;
+    return Tcl_CreateObjTrace( interp, level, 0, StringTraceProc,
+			       (ClientData) data, StringTraceDeleteProc );
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringTraceProc --
+ *
+ *	Invoke a string-based trace procedure from an object-based
+ *	callback.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Whatever the string-based trace procedure does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringTraceProc( clientData, interp, level, command, commandInfo, objc, objv )
+    ClientData clientData;
+    Tcl_Interp* interp;
+    int level;
+    CONST char* command;
+    Tcl_Command commandInfo;
+    int objc;
+    Tcl_Obj *CONST *objv;
+{
+    StringTraceData* data = (StringTraceData*) clientData;
+    Command* cmdPtr = (Command*) commandInfo;
+
+    CONST char** argv;		/* Args to pass to string trace proc */
+
+    int i;
+
+    /*
+     * This is a bit messy because we have to emulate the old trace
+     * interface, which uses strings for everything.
+     */
+	    
+    argv = (CONST char **) ckalloc((unsigned) ( (objc + 1)
+						* sizeof(CONST char *) ));
+    for (i = 0; i < objc; i++) {
+	argv[i] = Tcl_GetString(objv[i]);
+    }
+    argv[objc] = 0;
 
     /*
-     * Invalidate existing compiled code for this interpreter and arrange
-     * (by setting the DONT_COMPILE_CMDS_INLINE flag) that when compiling
-     * new code, no commands will be compiled inline (i.e., into an inline
-     * sequence of instructions). We do this because commands that were
-     * compiled inline will never result in a command trace being called.
+     * Invoke the command procedure.  Note that we cast away const-ness
+     * on two parameters for compatibility with legacy code; the code
+     * MUST NOT modify either command or argv.
      */
+	
+    ( data->proc )( data->clientData, interp, level,
+		    (char*) command, cmdPtr->proc, cmdPtr->clientData,
+		    objc, (char**) argv );
 
-    iPtr->compileEpoch++;
-    iPtr->flags |= DONT_COMPILE_CMDS_INLINE;
+    ckfree( (char*) argv );
 
-    tracePtr = (Trace *) ckalloc(sizeof(Trace));
-    tracePtr->level		= level;
-    tracePtr->proc		= proc;
-    tracePtr->clientData	= clientData;
-    tracePtr->nextPtr		= iPtr->tracePtr;
-    iPtr->tracePtr		= tracePtr;
+    return TCL_OK;
 
-    return (Tcl_Trace) tracePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringTraceDeleteProc --
+ *
+ *	Clean up memory when a string-based trace is deleted.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Allocated memory is returned to the system.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+StringTraceDeleteProc( clientData )
+    ClientData clientData;
+{
+    ckfree( (char*) clientData );
 }
 
 /*
@@ -4613,31 +4884,48 @@ Tcl_DeleteTrace(interp, trace)
     Tcl_Trace trace;		/* Token for trace (returned previously by
 				 * Tcl_CreateTrace). */
 {
-    register Interp *iPtr = (Interp *) interp;
-    register Trace *tracePtr = (Trace *) trace;
-    register Trace *tracePtr2;
+    Interp *iPtr = (Interp *) interp;
+    Trace *tracePtr = (Trace *) trace;
+    register Trace **tracePtr2 = &( iPtr->tracePtr );
 
-    if (iPtr->tracePtr == tracePtr) {
-	iPtr->tracePtr = tracePtr->nextPtr;
-	ckfree((char *) tracePtr);
-    } else {
-	for (tracePtr2 = iPtr->tracePtr; tracePtr2 != NULL;
-		tracePtr2 = tracePtr2->nextPtr) {
-	    if (tracePtr2->nextPtr == tracePtr) {
-		tracePtr2->nextPtr = tracePtr->nextPtr;
-		ckfree((char *) tracePtr);
-		break;
-	    }
+    /*
+     * Locate the trace entry in the interpreter's trace list,
+     * and remove it from the list.
+     */
+
+    while ( (*tracePtr2) != NULL && (*tracePtr2) != tracePtr ) {
+	tracePtr2 = &((*tracePtr2)->nextPtr);
+    }
+    if ( tracePtr2 == NULL ) {
+	return;
+    }
+    (*tracePtr2) = (*tracePtr2)->nextPtr;
+    
+    /*
+     * If the trace forbids bytecode compilation, change the interpreter's
+     * state.  If bytecode compilation is now permitted, flag the fact and
+     * advance the compilation epoch so that procs will be recompiled to
+     * take advantage of it.
+     */
+
+    if ( ! (tracePtr->flags & TCL_ALLOW_INLINE_COMPILATION ) ) {
+	-- iPtr->tracesForbiddingInline;
+	if ( iPtr->tracesForbiddingInline == 0 ) {
+	    iPtr->flags &= ~DONT_COMPILE_CMDS_INLINE;
+	    ++ iPtr->compileEpoch;
 	}
     }
 
-    if (iPtr->tracePtr == NULL) {
-	/*
-	 * When compiling new code, allow commands to be compiled inline.
-	 */
+    /*
+     * Execute any delete callback.
+     */
+
+    ( tracePtr->delProc )( tracePtr->clientData );
+
+    /* Delete the trace object */
+
+    ckfree( (char*) tracePtr );
 
-	iPtr->flags &= ~DONT_COMPILE_CMDS_INLINE;
-    }
 }
 
 /*
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 73790cb..563805d 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclDecls.h,v 1.81 2002/02/08 02:52:54 dgp Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.82 2002/02/10 20:36:34 kennykb Exp $
  */
 
 #ifndef _TCLDECLS
@@ -738,7 +738,8 @@ EXTERN int		Tcl_SetChannelOption _ANSI_ARGS_((
 				CONST char * newValue));
 /* 226 */
 EXTERN int		Tcl_SetCommandInfo _ANSI_ARGS_((Tcl_Interp * interp, 
-				CONST char * cmdName, Tcl_CmdInfo * infoPtr));
+				CONST char * cmdName, 
+				CONST Tcl_CmdInfo * infoPtr));
 /* 227 */
 EXTERN void		Tcl_SetErrno _ANSI_ARGS_((int err));
 /* 228 */
@@ -1519,6 +1520,19 @@ EXTERN int		Tcl_EvalTokensStandard _ANSI_ARGS_((
 				int count));
 /* 482 */
 EXTERN void		Tcl_GetTime _ANSI_ARGS_((Tcl_Time* timeBuf));
+/* 483 */
+EXTERN Tcl_Trace	Tcl_CreateObjTrace _ANSI_ARGS_((Tcl_Interp* interp, 
+				int level, int flags, 
+				Tcl_CmdObjTraceProc* objProc, 
+				ClientData clientData, 
+				Tcl_CmdObjTraceDeleteProc* delProc));
+/* 484 */
+EXTERN int		Tcl_GetCommandInfoFromToken _ANSI_ARGS_((
+				Tcl_Command token, Tcl_CmdInfo* infoPtr));
+/* 485 */
+EXTERN int		Tcl_SetCommandInfoFromToken _ANSI_ARGS_((
+				Tcl_Command token, 
+				CONST Tcl_CmdInfo* infoPtr));
 
 typedef struct TclStubHooks {
     struct TclPlatStubs *tclPlatStubs;
@@ -1804,7 +1818,7 @@ typedef struct TclStubs {
     void (*tcl_SetAssocData) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_InterpDeleteProc * proc, ClientData clientData)); /* 223 */
     void (*tcl_SetChannelBufferSize) _ANSI_ARGS_((Tcl_Channel chan, int sz)); /* 224 */
     int (*tcl_SetChannelOption) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, CONST char * optionName, CONST char * newValue)); /* 225 */
-    int (*tcl_SetCommandInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, Tcl_CmdInfo * infoPtr)); /* 226 */
+    int (*tcl_SetCommandInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, CONST Tcl_CmdInfo * infoPtr)); /* 226 */
     void (*tcl_SetErrno) _ANSI_ARGS_((int err)); /* 227 */
     void (*tcl_SetErrorCode) _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 228 */
     void (*tcl_SetMaxBlockTime) _ANSI_ARGS_((Tcl_Time * timePtr)); /* 229 */
@@ -2061,6 +2075,9 @@ typedef struct TclStubs {
     void (*tcl_FSMountsChanged) _ANSI_ARGS_((Tcl_Filesystem * fsPtr)); /* 480 */
     int (*tcl_EvalTokensStandard) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Token * tokenPtr, int count)); /* 481 */
     void (*tcl_GetTime) _ANSI_ARGS_((Tcl_Time* timeBuf)); /* 482 */
+    Tcl_Trace (*tcl_CreateObjTrace) _ANSI_ARGS_((Tcl_Interp* interp, int level, int flags, Tcl_CmdObjTraceProc* objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc* delProc)); /* 483 */
+    int (*tcl_GetCommandInfoFromToken) _ANSI_ARGS_((Tcl_Command token, Tcl_CmdInfo* infoPtr)); /* 484 */
+    int (*tcl_SetCommandInfoFromToken) _ANSI_ARGS_((Tcl_Command token, CONST Tcl_CmdInfo* infoPtr)); /* 485 */
 } TclStubs;
 
 #ifdef __cplusplus
@@ -4033,6 +4050,18 @@ extern TclStubs *tclStubsPtr;
 #define Tcl_GetTime \
 	(tclStubsPtr->tcl_GetTime) /* 482 */
 #endif
+#ifndef Tcl_CreateObjTrace
+#define Tcl_CreateObjTrace \
+	(tclStubsPtr->tcl_CreateObjTrace) /* 483 */
+#endif
+#ifndef Tcl_GetCommandInfoFromToken
+#define Tcl_GetCommandInfoFromToken \
+	(tclStubsPtr->tcl_GetCommandInfoFromToken) /* 484 */
+#endif
+#ifndef Tcl_SetCommandInfoFromToken
+#define Tcl_SetCommandInfoFromToken \
+	(tclStubsPtr->tcl_SetCommandInfoFromToken) /* 485 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 4b59e9f..dcb573c 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -7,12 +7,12 @@
  * Copyright (c) 1993-1997 Lucent Technologies.
  * Copyright (c) 1994-1998 Sun Microsystems, Inc.
  * Copyright (c) 1998-1999 by Scriptics Corporation.
- * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
+ * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
  *
  * 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.78 2002/01/31 04:39:43 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.79 2002/02/10 20:36:34 kennykb Exp $
  */
 
 #ifndef _TCLINT
@@ -646,9 +646,13 @@ typedef struct Proc {
 typedef struct Trace {
     int level;			/* Only trace commands at nesting level
 				 * less than or equal to this. */
-    Tcl_CmdTraceProc *proc;	/* Procedure to call to trace command. */
+    Tcl_CmdObjTraceProc *proc;	/* Procedure to call to trace command. */
     ClientData clientData;	/* Arbitrary value to pass to proc. */
     struct Trace *nextPtr;	/* Next in list of traces for this interp. */
+    int flags;			/* Flags governing the trace - see
+				 * Tcl_CreateObjTrace for details */
+    Tcl_CmdObjTraceDeleteProc* delProc;
+				/* Procedure to call when trace is deleted */
 } Trace;
 
 /*
@@ -1301,6 +1305,10 @@ typedef struct Interp {
     ActiveCommandTrace *activeCmdTracePtr;
 				/* First in list of active command traces for
 				 * interp, or NULL if no active traces. */
+
+    int tracesForbiddingInline; /* Count of traces (in the list headed by
+				 * tracePtr) that forbid inline bytecode
+				 * compilation */
     /*
      * Statistical information about the bytecode compiler and interpreter's
      * operation.
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 9f739bd..7285dac 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStubInit.c,v 1.66 2002/01/05 22:55:52 dgp Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.67 2002/02/10 20:36:34 kennykb Exp $
  */
 
 #include "tclInt.h"
@@ -885,6 +885,9 @@ TclStubs tclStubs = {
     Tcl_FSMountsChanged, /* 480 */
     Tcl_EvalTokensStandard, /* 481 */
     Tcl_GetTime, /* 482 */
+    Tcl_CreateObjTrace, /* 483 */
+    Tcl_GetCommandInfoFromToken, /* 484 */
+    Tcl_SetCommandInfoFromToken, /* 485 */
 };
 
 /* !END!: Do not edit above this line. */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index d220a9f..a8635bd 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTest.c,v 1.42 2002/02/01 17:17:59 vincentdarley Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.43 2002/02/10 20:36:34 kennykb Exp $
  */
 
 #define TCL_TEST
@@ -168,8 +168,16 @@ static int              NoopCmd _ANSI_ARGS_((ClientData clientData,
 static int              NoopObjCmd _ANSI_ARGS_((ClientData clientData,
                             Tcl_Interp *interp, int objc,
 			    Tcl_Obj *CONST objv[]));
+static int		ObjTraceProc _ANSI_ARGS_(( ClientData clientData,
+						   Tcl_Interp* interp,
+						   int level,
+						   CONST char* command,
+						   Tcl_Command commandToken,
+						   int objc,
+						   Tcl_Obj *CONST objv[] ));
+static void		ObjTraceDeleteProc _ANSI_ARGS_(( ClientData ));
 static void		PrintParse _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Parse *parsePtr));
+						Tcl_Parse *parsePtr));
 static void		SpecialFree _ANSI_ARGS_((char *blockPtr));
 static int		StaticInitProc _ANSI_ARGS_((Tcl_Interp *interp));
 static int		TestaccessprocCmd _ANSI_ARGS_((ClientData dummy,
@@ -1031,9 +1039,30 @@ TestcmdtraceCmd(dummy, interp, argc, argv)
 	cmdTrace = Tcl_CreateTrace(interp, 50000,
 	        (Tcl_CmdTraceProc *) CmdTraceDeleteProc, (ClientData) NULL);
 	Tcl_Eval(interp, argv[2]);
+    } else if ( strcmp(argv[1], "resulttest" ) == 0 ) {
+	/* Create an object-based trace, then eval a script. This is used
+	 * to test return codes other than TCL_OK from the trace engine.
+	 */
+	static int deleteCalled;
+	deleteCalled = 0;
+	cmdTrace = Tcl_CreateObjTrace( interp, 50000,
+				       TCL_ALLOW_INLINE_COMPILATION,
+				       ObjTraceProc,
+				       (ClientData) &deleteCalled,
+				       ObjTraceDeleteProc );
+	result = Tcl_Eval( interp, argv[ 2 ] );
+	Tcl_DeleteTrace( interp, cmdTrace );
+	if ( !deleteCalled ) {
+	    Tcl_SetResult( interp, "Delete wasn't called", TCL_STATIC );
+	    return TCL_ERROR;
+	} else {
+	    return result;
+	}
+	
     } else {
 	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": must be tracetest or deletetest", (char *) NULL);
+			 "\": must be tracetest, deletetest or resulttest",
+			 (char *) NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -1090,6 +1119,41 @@ CmdTraceDeleteProc(clientData, interp, level, command, cmdProc,
     Tcl_DeleteTrace(interp, cmdTrace);
 }
 
+static int
+ObjTraceProc( clientData, interp, level, command, token, objc, objv )
+    ClientData clientData;	/* unused */
+    Tcl_Interp* interp;		/* Tcl interpreter */
+    int level;			/* Execution level */
+    CONST char* command;	/* Command being executed */
+    Tcl_Command token;		/* Command information */
+    int objc;			/* Parameter count */
+    Tcl_Obj *CONST objv[];	/* Parameter list */
+{
+    CONST char* word = Tcl_GetString( objv[ 0 ] );
+    if ( !strcmp( word, "Error" ) ) {
+	Tcl_SetObjResult( interp, Tcl_NewStringObj( command, -1 ) );
+	return TCL_ERROR;
+    } else if ( !strcmp( word, "Break" ) ) {
+	return TCL_BREAK;
+    } else if ( !strcmp( word, "Continue" ) ) {
+	return TCL_CONTINUE;
+    } else if ( !strcmp( word, "Return" ) ) {
+	return TCL_RETURN;
+    } else if ( !strcmp( word, "OtherStatus" ) ) {
+	return 6;
+    } else {
+	return TCL_OK;
+    }
+}
+
+static void
+ObjTraceDeleteProc( clientData )
+    ClientData clientData;
+{
+    int * intPtr = (int *) clientData;
+    *intPtr = 1;		/* Record that the trace was deleted */
+}
+
 /*
  *----------------------------------------------------------------------
  *
diff --git a/tests/basic.test b/tests/basic.test
index f088b41..70472a8 100644
--- a/tests/basic.test
+++ b/tests/basic.test
@@ -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: basic.test,v 1.14 2002/01/03 18:23:47 dkf Exp $
+# RCS: @(#) $Id: basic.test,v 1.15 2002/02/10 20:36:34 kennykb Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -509,7 +509,38 @@ test basic-39.4 {Tcl_CreateTrace, check that tracing doesn't cause memory faults
 catch {rename tracer {}}
 catch {rename tracedLoop {}}
 
+test basic-39.5 {Tcl_CreateObjTrace, status return TCL_ERROR} {testcmdtrace} {
+    proc Error { args } { error "Shouldn't get here" }
+    set x 1;
+    list [catch {testcmdtrace resulttest {Error $x}} result] [set result]
+} {1 {Error $x}}
+
+test basic-39.6 {Tcl_CreateObjTrace, status return TCL_RETURN} {testcmdtrace} {
+    proc Return { args } { error "Shouldn't get here" }
+    set x 1;
+    list [catch {testcmdtrace resulttest {Return $x}} result] [set result]
+} {2 {}}
+
+test basic-39.7 {Tcl_CreateObjTrace, status return TCL_BREAK} {testcmdtrace} {
+    proc Break { args } { error "Shouldn't get here" }
+    set x 1;
+    list [catch {testcmdtrace resulttest {Break $x}} result] [set result]
+} {3 {}}
+
+test basic-39.8 {Tcl_CreateObjTrace, status return TCL_CONTINUE} {testcmdtrace} {
+    proc Continue { args } { error "Shouldn't get here" }
+    set x 1;
+    list [catch {testcmdtrace resulttest {Continue $x}} result] [set result]
+} {4 {}}
+
+test basic-39.9 {Tcl_CreateObjTrace, status return unknown} {testcmdtrace} {
+    proc OtherStatus { args } { error "Shouldn't get here" }
+    set x 1;
+    list [catch {testcmdtrace resulttest {OtherStatus $x}} result] [set result]
+} {6 {}}
+
 test basic-40.1 {Tcl_DeleteTrace} {emptyTest} {
+    # the above tests have tested Tcl_DeleteTrace
 } {}
 
 test basic-41.1 {Tcl_AddErrorInfo} {emptyTest} {