diff options
| -rw-r--r-- | ChangeLog | 10 | ||||
| -rw-r--r-- | generic/tclCompile.c | 47 | ||||
| -rw-r--r-- | generic/tclHistory.c | 45 | ||||
| -rw-r--r-- | generic/tclInt.h | 4 | ||||
| -rw-r--r-- | generic/tclProc.c | 47 |
5 files changed, 90 insertions, 63 deletions
@@ -1,3 +1,13 @@ +2006-09-30 Miguel Sofer <msofer@users.sf.net> + + * generic/tclCompile.c: + * generic/tclHistory.c: + * generic/tclInt.h: + * generic/tclProc.c: made Tcl_RecordAndEvalObj not call "history" + if it has been redefined to an empty proc, in order to reduce the + noise when debugging [FR 1190441]. Moved TclCompileNoOp from + tclProc.c to tclCompile.c + 2006-09-28 Andreas Kupries <andreask@activestate.com> * generic/tclPkg.c (CompareVersions): Bugfix. Check string lengths diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 2be8b05..ddaee64 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -11,7 +11,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.97 2006/08/29 06:28:38 das Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.98 2006/09/30 17:56:46 msofer Exp $ */ #include "tclInt.h" @@ -1636,6 +1636,51 @@ TclCompileExprWords( /* *---------------------------------------------------------------------- * + * TclCompileNoOp -- + * + * Function called to compile no-op's + * + * Results: + * The return value is TCL_OK, indicating successful compilation. + * + * Side effects: + * Instructions are added to envPtr to execute a no-op at runtime. No + * result is pushed onto the stack: the compiler has to take care of this + * itself if the last compiled command is a NoOp. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileNoOp( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Token *tokenPtr; + int i; + int savedStackDepth = envPtr->currStackDepth; + + tokenPtr = parsePtr->tokenPtr; + for(i = 1; i < parsePtr->numWords; i++) { + tokenPtr = tokenPtr + tokenPtr->numComponents + 1; + envPtr->currStackDepth = savedStackDepth; + + if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, + envPtr); + TclEmitOpcode(INST_POP, envPtr); + } + } + envPtr->currStackDepth = savedStackDepth; + TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TclInitByteCodeObj -- * * Create a ByteCode structure and initialize it from a CompileEnv diff --git a/generic/tclHistory.c b/generic/tclHistory.c index daef8f3..e77b230 100644 --- a/generic/tclHistory.c +++ b/generic/tclHistory.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclHistory.c,v 1.8 2005/10/18 14:34:41 dkf Exp $ + * RCS: @(#) $Id: tclHistory.c,v 1.9 2006/09/30 17:56:47 msofer Exp $ */ #include "tclInt.h" @@ -112,29 +112,44 @@ Tcl_RecordAndEvalObj( * in global variable context instead of the * current procedure. */ { - int result; + int result, call = 1; Tcl_Obj *list[3]; register Tcl_Obj *objPtr; + Tcl_CmdInfo info; /* - * Do recording by eval'ing a tcl history command: history add $cmd. + * Do not call [history] if it has been replaced by an empty proc */ - list[0] = Tcl_NewStringObj("history", -1); - list[1] = Tcl_NewStringObj("add", -1); - list[2] = cmdPtr; + result = Tcl_GetCommandInfo(interp, "history", &info); - objPtr = Tcl_NewListObj(3, list); - Tcl_IncrRefCount(objPtr); - (void) Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL); - Tcl_DecrRefCount(objPtr); + if (result && (info.objProc == TclObjInterpProc)) { + Proc *procPtr = (Proc *)(info.objClientData); + call = (procPtr->cmdPtr->compileProc != TclCompileNoOp); + } - /* - * One possible failure mode above: exceeding a resource limit. - */ + if (call) { - if (Tcl_LimitExceeded(interp)) { - return TCL_ERROR; + /* + * Do recording by eval'ing a tcl history command: history add $cmd. + */ + + list[0] = Tcl_NewStringObj("history", -1); + list[1] = Tcl_NewStringObj("add", -1); + list[2] = cmdPtr; + + objPtr = Tcl_NewListObj(3, list); + Tcl_IncrRefCount(objPtr); + (void) Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL); + Tcl_DecrRefCount(objPtr); + + /* + * One possible failure mode above: exceeding a resource limit. + */ + + if (Tcl_LimitExceeded(interp)) { + return TCL_ERROR; + } } /* diff --git a/generic/tclInt.h b/generic/tclInt.h index 9a0edf7..a3d6f48 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * 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.277 2006/09/22 22:32:07 andreas_kupries Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.278 2006/09/30 17:56:47 msofer Exp $ */ #ifndef _TCLINT @@ -2554,6 +2554,8 @@ MODULE_SCOPE int TclCompileLlengthCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileLsetCmd(Tcl_Interp* interp, Tcl_Parse* parsePtr, struct CompileEnv* envPtr); +MODULE_SCOPE int TclCompileNoOp(Tcl_Interp *interp, Tcl_Parse *parsePtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileRegexpCmd(Tcl_Interp* interp, Tcl_Parse* parsePtr, struct CompileEnv* envPtr); MODULE_SCOPE int TclCompileReturnCmd(Tcl_Interp *interp, diff --git a/generic/tclProc.c b/generic/tclProc.c index 2069ea9..035de96 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -11,7 +11,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.91 2006/05/15 16:07:47 dgp Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.92 2006/09/30 17:56:47 msofer Exp $ */ #include "tclInt.h" @@ -35,8 +35,6 @@ static void ProcBodyFree(Tcl_Obj *objPtr); static int ProcessProcResultCode(Tcl_Interp *interp, char *procName, int nameLen, int returnCode); static int SetLambdaFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); -static int TclCompileNoOp(Tcl_Interp *interp, Tcl_Parse *parsePtr, - struct CompileEnv *envPtr); static int ProcCompileProc (Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, CONST char *description, CONST char *procName, @@ -1962,49 +1960,6 @@ ProcBodyFree( } /* - *---------------------------------------------------------------------- - * - * TclCompileNoOp -- - * - * Function called to compile no-op's - * - * Results: - * The return value is TCL_OK, indicating successful compilation. - * - * Side effects: - * Instructions are added to envPtr to execute a no-op at runtime. - * - *---------------------------------------------------------------------- - */ - -static int -TclCompileNoOp( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ -{ - Tcl_Token *tokenPtr; - int i; - int savedStackDepth = envPtr->currStackDepth; - - tokenPtr = parsePtr->tokenPtr; - for(i = 1; i < parsePtr->numWords; i++) { - tokenPtr = tokenPtr + tokenPtr->numComponents + 1; - envPtr->currStackDepth = savedStackDepth; - - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, - envPtr); - TclEmitOpcode(INST_POP, envPtr); - } - } - envPtr->currStackDepth = savedStackDepth; - TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); - return TCL_OK; -} - -/* * LAMBDA and APPLY implementation. [TIP#194] */ |