Factored out the trace code - it's big enough to be its own maintenance area

and tricky enough to discourage non-specialists...

1 files changed, 1 insertions, 338 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index cb7bb9e..cf8a758 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.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: tclBasic.c,v 1.84 2003/06/10 19:46:42 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.85 2003/06/25 23:02:11 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -32,14 +32,6 @@ 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;
 
@@ -251,16 +243,6 @@ static CmdInfo builtInCmds[] = {
     {NULL,		(Tcl_CmdProc *) NULL,	(Tcl_ObjCmdProc *) NULL,
         (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;
 
 /*
  *----------------------------------------------------------------------
@@ -4555,325 +4537,6 @@ 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;
-    tracePtr->flags		= flags;
-    iPtr->tracePtr		= tracePtr;
-
-    return (Tcl_Trace) tracePtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_CreateTrace --
- *
- *	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, interp, level, command, cmdProc, cmdClientData,
- *		argc, argv)
- *	    ClientData clientData;
- *	    Tcl_Interp *interp;
- *	    int level;
- *	    char *command;
- *	    int (*cmdProc)();
- *	    ClientData cmdClientData;
- *	    int argc;
- *	    char **argv;
- *	{
- *	}
- *
- *	The clientData and interp arguments to proc will be the same
- *	as the corresponding arguments to this procedure.  Level gives
- *	the nesting level of command interpretation for this interpreter
- *	(0 corresponds to top level).  Command gives the ASCII text of
- *	the raw command, cmdProc and cmdClientData give the procedure that
- *	will be called to process the command and the ClientData value it
- *	will receive, and argc and argv give the arguments to the
- *	command, after any argument parsing and substitution.  Proc
- *	does not return a value.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Trace
-Tcl_CreateTrace(interp, level, proc, clientData)
-    Tcl_Interp *interp;		/* Interpreter in which to create trace. */
-    int level;			/* Only call proc for commands at nesting
-				 * level<=argument level (1=>top level). */
-    Tcl_CmdTraceProc *proc;	/* Procedure to call before executing each
-				 * command. */
-    ClientData clientData;	/* Arbitrary value word to pass to proc. */
-{
-    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;
-
-    /*
-     * 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, argv );
-    ckfree( (char*) argv );
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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 );
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DeleteTrace --
- *
- *	Remove a trace.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	From now on there will be no more calls to the procedure given
- *	in trace.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_DeleteTrace(interp, trace)
-    Tcl_Interp *interp;		/* Interpreter that contains trace. */
-    Tcl_Trace trace;		/* Token for trace (returned previously by
-				 * Tcl_CreateTrace). */
-{
-    Interp *iPtr = (Interp *) interp;
-    Trace *tracePtr = (Trace *) trace;
-    register Trace **tracePtr2 = &(iPtr->tracePtr);
-
-    /*
-     * 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++;
-	}
-    }
-
-    /*
-     * Execute any delete callback.
-     */
-
-    if (tracePtr->delProc != NULL) {
-	(tracePtr->delProc)(tracePtr->clientData);
-    }
-
-    /* Delete the trace object */
-
-    Tcl_EventuallyFree((char*)tracePtr, TCL_DYNAMIC);
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * Tcl_AddErrorInfo --
  *
  *	Add information to the "errorInfo" variable that describes the