summaryrefslogtreecommitdiffstats
path: root/generic/tclBasic.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2003-06-25 23:02:10 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2003-06-25 23:02:10 (GMT)
commit43e3bcc7712f80d3c36696dbc1f9349f2819fe27 (patch)
tree9e458c1fda7815410cef063c83bd16dfb8e14927 /generic/tclBasic.c
parentb2985d83d53d176dc990188526b12b93860253c7 (diff)
downloadtcl-43e3bcc7712f80d3c36696dbc1f9349f2819fe27.zip
tcl-43e3bcc7712f80d3c36696dbc1f9349f2819fe27.tar.gz
tcl-43e3bcc7712f80d3c36696dbc1f9349f2819fe27.tar.bz2
Factored out the trace code - it's big enough to be its own maintenance area
and tricky enough to discourage non-specialists...
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r--generic/tclBasic.c339
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