diff options
Diffstat (limited to 'generic/tclBasic.c')
| -rw-r--r-- | generic/tclBasic.c | 339 |
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 |