From a073fa09353e6e69476cbbb61777eedd0af5cc19 Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Mon, 17 Sep 2001 11:51:58 +0000 Subject: Disabled all compile and execution tracing functionality in standard builds [Bug 451858]. --- ChangeLog | 16 +++++++++++++--- doc/tclvars.n | 8 +++++++- generic/tclCompile.c | 11 ++++++++--- generic/tclCompile.h | 6 +++++- generic/tclExecute.c | 19 +++++++++---------- generic/tclProc.c | 10 +++++----- 6 files changed, 47 insertions(+), 23 deletions(-) diff --git a/ChangeLog b/ChangeLog index b06a57e..f617372 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2001-09-13 Miguel Sofer + + * doc/tclvars.n: + * generic/tclCompile.c: + * generic/tclCompile.h: + * generic/tclExecute.c: + * generic/tclProc.c: disbabled all compile and execution tracing + functionality in standard builds; TCL_COMPILE_DEBUG is now + necessary to enable it. [Bug 451858] + 2001-09-14 Andreas Kupries * doc/gets.n: @@ -60,8 +70,8 @@ by the new Tcl_EvalTokensStandard. The new function performs the same duties but adheres to the standard return convention for Tcl evaluations; the deprecated function could only return TCL_OK or - TCL_ERROR, which caused [Bug: 219384] and [Bug: 455151]. - This patch implements [TIP: 56]. + TCL_ERROR, which caused [Bug 219384] and [Bug 455151]. + This patch implements [TIP 56]. 2001-09-12 Mo DeJong @@ -371,7 +381,7 @@ * generic/tclProc.c: * tests/proc.test: made [proc] check that formal args have - simple names [Bug: 458548] + simple names [Bug 458548] 2001-09-04 Vince Darley diff --git a/doc/tclvars.n b/doc/tclvars.n index 56c95d9..2c51750 100644 --- a/doc/tclvars.n +++ b/doc/tclvars.n @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: tclvars.n,v 1.8 2000/09/07 14:27:51 poenitz Exp $ +'\" RCS: @(#) $Id: tclvars.n,v 1.9 2001/09/17 11:51:58 msofer Exp $ '\" .so man.macros .TH tclvars n 8.0 Tcl "Tcl Built-In Commands" @@ -346,6 +346,9 @@ This variable is useful in tracking down suspected problems with the Tcl compiler. It is also occasionally useful when converting existing code to use Tcl8.0. + +This variable and functionality only exist if +TCL_COMPILE_DEBUG was defined during Tcl's compilation. .TP \fBtcl_traceExec\fR The value of this variable can be set to control @@ -368,6 +371,9 @@ tracking down suspected problems with the bytecode compiler and interpreter. It is also occasionally useful when converting code to use Tcl8.0. + +This variable and functionality only exist if +TCL_COMPILE_DEBUG was defined during Tcl's compilation. .TP \fBtcl_wordchars\fR The value of this variable is a regular expression that can be set to diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 8250b7e..6bd7ca2 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.23 2001/09/04 11:54:27 msofer Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.24 2001/09/17 11:51:58 msofer Exp $ */ #include "tclInt.h" @@ -34,8 +34,10 @@ TCL_DECLARE_MUTEX(tableMutex) * This variable is linked to the Tcl variable "tcl_traceCompile". */ +#ifdef TCL_COMPILE_DEBUG int tclTraceCompile = 0; static int traceInitialized = 0; +#endif /* * A table describing the Tcl bytecode instructions. Entries in this table @@ -340,6 +342,7 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData) int length, nested, result; char *string; +#ifdef TCL_COMPILE_DEBUG if (!traceInitialized) { if (Tcl_LinkVar(interp, "tcl_traceCompile", (char *) &tclTraceCompile, TCL_LINK_INT) != TCL_OK) { @@ -347,6 +350,7 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData) } traceInitialized = 1; } +#endif if (iPtr->evalFlags & TCL_BRACKET_TERM) { nested = 1; @@ -384,7 +388,7 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData) TclInitByteCodeObj(objPtr, &compEnv); #ifdef TCL_COMPILE_DEBUG - if (tclTraceCompile == 2) { + if (tclTraceCompile >= 2) { TclPrintByteCodeObj(interp, objPtr); } #endif /* TCL_COMPILE_DEBUG */ @@ -871,6 +875,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr) commandLength -= 1; } +#ifdef TCL_COMPILE_DEBUG /* * If tracing, print a line for each top level command compiled. */ @@ -882,7 +887,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr) TclMin(commandLength, 55)); fprintf(stdout, "\n"); } - +#endif /* * Each iteration of the following loop compiles one word * from the command. diff --git a/generic/tclCompile.h b/generic/tclCompile.h index ec8f120..57b24fe 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -7,7 +7,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.h,v 1.15 2001/05/17 02:13:02 hobbs Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.16 2001/09/17 11:51:58 msofer Exp $ */ #ifndef _TCLCOMPILATION @@ -37,6 +37,7 @@ extern Tcl_ObjType tclCmdNameType; +#ifdef TCL_COMPILE_DEBUG /* * Variable that controls whether compilation tracing is enabled and, if so, * what level of tracing is desired: @@ -47,7 +48,9 @@ extern Tcl_ObjType tclCmdNameType; */ extern int tclTraceCompile; +#endif +#ifdef TCL_COMPILE_DEBUG /* * Variable that controls whether execution tracing is enabled and, if so, * what level of tracing is desired: @@ -59,6 +62,7 @@ extern int tclTraceCompile; */ extern int tclTraceExec; +#endif /* *------------------------------------------------------------------------ diff --git a/generic/tclExecute.c b/generic/tclExecute.c index c420e95..7ce214b 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.29 2001/09/03 17:34:16 hobbs Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.30 2001/09/17 11:51:58 msofer Exp $ */ #include "tclInt.h" @@ -51,6 +51,7 @@ int errno; static int execInitialized = 0; TCL_DECLARE_MUTEX(execMutex) +#ifdef TCL_COMPILE_DEBUG /* * Variable that controls whether execution tracing is enabled and, if so, * what level of tracing is desired: @@ -62,6 +63,7 @@ TCL_DECLARE_MUTEX(execMutex) */ int tclTraceExec = 0; +#endif typedef struct ThreadSpecificData { /* @@ -358,11 +360,12 @@ InitByteCodeExecution(interp) * instruction tracing. */ { Tcl_RegisterObjType(&tclCmdNameType); +#ifdef TCL_COMPILE_DEBUG if (Tcl_LinkVar(interp, "tcl_traceExec", (char *) &tclTraceExec, TCL_LINK_INT) != TCL_OK) { panic("InitByteCodeExecution: can't create link for tcl_traceExec variable"); } - +#endif #ifdef TCL_COMPILE_STATS Tcl_CreateCommand(interp, "evalstats", EvalStatsCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); @@ -555,7 +558,9 @@ TclExecuteByteCode(interp, codePtr) * instructions and processCatch to * process break, continue, and errors. */ int result = TCL_OK; /* Return code returned after execution. */ +#ifdef TCL_COMPILE_DEBUG int traceInstructions = (tclTraceExec == 3); +#endif Tcl_Obj *valuePtr, *value2Ptr, *objPtr, *elemPtr; char *bytes; int length; @@ -614,7 +619,6 @@ TclExecuteByteCode(interp, codePtr) #ifdef TCL_COMPILE_DEBUG ValidatePcAndStackTop(codePtr, pc, stackTop, initStackTop, eePtr->stackEnd); -#else /* not TCL_COMPILE_DEBUG */ if (traceInstructions) { fprintf(stdout, "%2d: %2d ", iPtr->numLevels, stackTop); TclPrintInstruction(codePtr, pc); @@ -849,8 +853,8 @@ TclExecuteByteCode(interp, codePtr) */ Tcl_ResetResult(interp); - if (tclTraceExec >= 2) { #ifdef TCL_COMPILE_DEBUG + if (tclTraceExec >= 2) { if (traceInstructions) { strncpy(cmdNameBuf, Tcl_GetString(objv[0]), 20); TRACE(("%u => call ", (isUnknownCmd? objc-1:objc))); @@ -865,13 +869,8 @@ TclExecuteByteCode(interp, codePtr) } fprintf(stdout, "\n"); fflush(stdout); -#else /* TCL_COMPILE_DEBUG */ - fprintf(stdout, "%d: (%u) invoking %s\n", - iPtr->numLevels, - (unsigned int)(pc - codePtr->codeStart), - Tcl_GetString(objv[0])); -#endif /*TCL_COMPILE_DEBUG*/ } +#endif /*TCL_COMPILE_DEBUG*/ iPtr->cmdCount++; DECACHE_STACK_INFO(); diff --git a/generic/tclProc.c b/generic/tclProc.c index 2980ae4..d5b7cb3 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclProc.c,v 1.27 2001/09/10 17:04:10 msofer Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.28 2001/09/17 11:51:59 msofer Exp $ */ #include "tclInt.h" @@ -1058,19 +1058,17 @@ TclObjInterpProc(clientData, interp, objc, objv) * Invoke the commands in the procedure's body. */ - if (tclTraceExec >= 1) { #ifdef TCL_COMPILE_DEBUG + if (tclTraceExec >= 1) { fprintf(stdout, "Calling proc "); for (i = 0; i < objc; i++) { TclPrintObject(stdout, objv[i], 15); fprintf(stdout, " "); } fprintf(stdout, "\n"); -#else /* TCL_COMPILE_DEBUG */ - fprintf(stdout, "Calling proc %.*s\n", nameLen, procName); -#endif /*TCL_COMPILE_DEBUG*/ fflush(stdout); } +#endif /*TCL_COMPILE_DEBUG*/ iPtr->returnCode = TCL_OK; procPtr->refCount++; @@ -1172,6 +1170,7 @@ TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName) int numChars; char *ellipsis; +#ifdef TCL_COMPILE_DEBUG if (tclTraceCompile >= 1) { /* * Display a line summarizing the top level command we @@ -1187,6 +1186,7 @@ TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName) fprintf(stdout, "Compiling %s \"%.*s%s\"\n", description, numChars, procName, ellipsis); } +#endif /* * Plug the current procPtr into the interpreter and coerce -- cgit v0.12