diff options
| -rw-r--r-- | ChangeLog | 23 | ||||
| -rw-r--r-- | generic/tclBasic.c | 356 | ||||
| -rw-r--r-- | generic/tclExecute.c | 45 | ||||
| -rw-r--r-- | generic/tclInt.h | 37 | ||||
| -rw-r--r-- | generic/tclInterp.c | 7 | ||||
| -rw-r--r-- | generic/tclObj.c | 4 | ||||
| -rw-r--r-- | generic/tclTrace.c | 46 |
7 files changed, 359 insertions, 159 deletions
@@ -1,3 +1,26 @@ +2007-06-09 Miguel Sofer <msofer@users.sf.net> + + * generic/tclBasic.c: Split TEOv in two, by separating a + processor for non-TCL_OK returns. Also spli TEOvI in a full + version that handles non-existing and traced commands, and a + separate shorter version for the regular case. + + * generic/tclBasic.c: Moved the generation of command strings for + * generic/tclTrace.c: traces: previously in Tcl_EvalObjv(), now + in TclCheck[Interp|Execution]Traces(). Also insured that the + strings are properly nul terminated at the correct length + [Bug 1693986] + + * generic/tclBasic.c: Extend usage of TclLimitReady() and + * generic/tclExecute.c: (new) TclLimitExceeded() macros. + * generic/tclInt.h: + * generic/tclInterp.c: + + * generic/tclInt.h: New TclCleanupCommandMacro for core usage. + * generic/tclBasic.c: + * generic/tclExecute.c: + * generic/tclObj.c: + 2007-06-09 Daniel Steffen <das@users.sourceforge.net> * macosx/Tcl.xcodeproj/project.pbxproj: add new Tclsh-Info.plist.in. diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 06cc63e..61b662b 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.246 2007/06/05 17:57:06 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.247 2007/06/09 20:12:54 msofer Exp $ */ #include "tclInt.h" @@ -91,6 +91,12 @@ static int ExprWideFunc(ClientData clientData, Tcl_Interp *interp, static void MathFuncWrongNumArgs(Tcl_Interp* interp, int expected, int actual, Tcl_Obj *const *objv); +static int FullEvalObjvInternal(Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[], const char *command, + int length, int flags); +static int ProcessEvalObjvReturn(Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[], int flags, int code); + extern TclStubs tclStubs; /* @@ -2271,7 +2277,7 @@ TclRenameCommand( * deleted by invocation of rename traces. */ - TclCleanupCommand(cmdPtr); + TclCleanupCommandMacro(cmdPtr); result = TCL_OK; done: @@ -2756,7 +2762,7 @@ Tcl_DeleteCommandFromToken( * looks up the command in the command hashtable). */ - TclCleanupCommand(cmdPtr); + TclCleanupCommandMacro(cmdPtr); return 0; } @@ -3392,15 +3398,18 @@ TclInterpReady( * Side effects: * Depends on the command. * - * Note to maintainers: - * This function has to be kept in sync with the shortcut version in + * Notes to maintainers: + * * This function has to be kept in sync with the shortcut version in * TclExecuteByteCode (INST_INVOKE). + * * This function has been split in two: a full version that processes + * unknown an traced commands too, and a shorter one that handles the + * normal case. They have to be kept in sync. * *---------------------------------------------------------------------- */ -int -TclEvalObjvInternal( +static int +FullEvalObjvInternal( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ int objc, /* Number of words in command. */ @@ -3408,10 +3417,9 @@ TclEvalObjvInternal( * the words that make up the command. */ const char *command, /* Points to the beginning of the string * representation of the command; this is used - * for traces. If the string representation of - * the command is unknown, an empty string - * should be supplied. If it is NULL, no - * traces will be called. */ + * for traces. NULL if the string + * representation of the command is unknown is + * to be generated from (objc,objv).*/ int length, /* Number of bytes in command; if -1, all * characters up to the first null byte are * used. */ @@ -3429,17 +3437,10 @@ TclEvalObjvInternal( int code = TCL_OK; int traceCode = TCL_OK; int checkTraces = 1; + int haveTraces; Namespace *savedNsPtr = NULL; Namespace *lookupNsPtr = iPtr->lookupNsPtr; - if (TclInterpReady(interp) == TCL_ERROR) { - return TCL_ERROR; - } - - if (objc == 0) { - return TCL_OK; - } - /* * If any execution traces rename or delete the current command, we may * need (at most) two passes here. @@ -3451,18 +3452,20 @@ TclEvalObjvInternal( * Configure evaluation context to match the requested flags. */ - if ((flags & TCL_EVAL_GLOBAL) && (varFramePtr != iPtr->rootFramePtr) - && !savedVarFramePtr) { - varFramePtr = iPtr->rootFramePtr; - savedVarFramePtr = iPtr->varFramePtr; - iPtr->varFramePtr = varFramePtr; - } else if (flags & TCL_EVAL_INVOKE) { - savedNsPtr = varFramePtr->nsPtr; - if (lookupNsPtr) { - varFramePtr->nsPtr = lookupNsPtr; - iPtr->lookupNsPtr = NULL; - } else { - varFramePtr->nsPtr = iPtr->globalNsPtr; + if (flags) { + if (flags & TCL_EVAL_INVOKE) { + savedNsPtr = varFramePtr->nsPtr; + if (lookupNsPtr) { + varFramePtr->nsPtr = lookupNsPtr; + iPtr->lookupNsPtr = NULL; + } else { + varFramePtr->nsPtr = iPtr->globalNsPtr; + } + } else if ((flags & TCL_EVAL_GLOBAL) && (varFramePtr != iPtr->rootFramePtr) + && !savedVarFramePtr) { + varFramePtr = iPtr->rootFramePtr; + savedVarFramePtr = iPtr->varFramePtr; + iPtr->varFramePtr = varFramePtr; } } @@ -3567,7 +3570,8 @@ TclEvalObjvInternal( * Call trace functions if needed. */ - if (checkTraces && (command != NULL)) { + haveTraces = (iPtr->tracePtr != NULL) || (cmdPtr->flags & CMD_HAS_EXEC_TRACES); + if (haveTraces && checkTraces) { int cmdEpoch = cmdPtr->cmdEpoch; int newEpoch; @@ -3587,7 +3591,7 @@ TclEvalObjvInternal( cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv); } newEpoch = cmdPtr->cmdEpoch; - TclCleanupCommand(cmdPtr); + TclCleanupCommandMacro(cmdPtr); /* * If the traces modified/deleted the command or any existing traces, @@ -3609,7 +3613,7 @@ TclEvalObjvInternal( cmdPtr->refCount++; iPtr->cmdCount++; - if (code == TCL_OK && traceCode == TCL_OK && !Tcl_LimitExceeded(interp)) { + if (code == TCL_OK && traceCode == TCL_OK && !TclLimitExceeded(iPtr->limit)) { if (!(flags & TCL_EVAL_INVOKE) && (iPtr->ensembleRewrite.sourceObjs != NULL)) { iPtr->ensembleRewrite.sourceObjs = NULL; @@ -3619,7 +3623,7 @@ TclEvalObjvInternal( if (Tcl_AsyncReady()) { code = Tcl_AsyncInvoke(interp, code); } - if (code == TCL_OK && Tcl_LimitReady(interp)) { + if (code == TCL_OK && TclLimitReady(iPtr->limit)) { code = Tcl_LimitCheck(interp); } @@ -3627,33 +3631,164 @@ TclEvalObjvInternal( * Call 'leave' command traces */ - if (!(cmdPtr->flags & CMD_IS_DELETED)) { - if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) { - traceCode = TclCheckExecutionTraces(interp, command, length, - cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv); + if (haveTraces) { + if (!(cmdPtr->flags & CMD_IS_DELETED)) { + if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) { + traceCode = TclCheckExecutionTraces(interp, command, length, + cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv); + } + if (iPtr->tracePtr != NULL && traceCode == TCL_OK) { + traceCode = TclCheckInterpTraces(interp, command, length, + cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv); + } } - if (iPtr->tracePtr != NULL && traceCode == TCL_OK) { - traceCode = TclCheckInterpTraces(interp, command, length, - cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv); + + /* + * If one of the trace invocation resulted in error, then change the + * result code accordingly. Note, that the interp->result should + * already be set correctly by the call to TraceExecutionProc. + */ + + if (traceCode != TCL_OK) { + code = traceCode; } - } + } + /* * Decrement the reference count of cmdPtr and deallocate it if it has * dropped to zero. */ - TclCleanupCommand(cmdPtr); + TclCleanupCommandMacro(cmdPtr); /* - * If one of the trace invocation resulted in error, then change the - * result code accordingly. Note, that the interp->result should already - * be set correctly by the call to TraceExecutionProc. + * If the interpreter has a non-empty string result, the result object is + * either empty or stale because some function set interp->result + * directly. If so, move the string result to the result object, then + * reset the string result. */ - if (traceCode != TCL_OK) { - code = traceCode; + if (*(iPtr->result) != 0) { + (void) Tcl_GetObjResult(interp); + } + + done: + if (savedVarFramePtr) { + iPtr->varFramePtr = savedVarFramePtr; } + return code; +} + +int +TclEvalObjvInternal( + Tcl_Interp *interp, /* Interpreter in which to evaluate the + * command. Also used for error reporting. */ + int objc, /* Number of words in command. */ + Tcl_Obj *const objv[], /* An array of pointers to objects that are + * the words that make up the command. */ + const char *command, /* Points to the beginning of the string + * representation of the command; this is used + * for traces. NULL if the string + * representation of the command is unknown is + * to be generated from (objc,objv).*/ + int length, /* Number of bytes in command; if -1, all + * characters up to the first null byte are + * used. */ + int flags) /* Collection of OR-ed bits that control the + * evaluation of the script. Only + * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are + * currently supported. */ +{ + Command *cmdPtr; + Interp *iPtr = (Interp *) interp; + CallFrame *savedVarFramePtr = NULL; + CallFrame *varFramePtr = iPtr->varFramePtr; + int code = TCL_OK; + Namespace *savedNsPtr = NULL; + Namespace *lookupNsPtr = iPtr->lookupNsPtr; + + if (TclInterpReady(interp) == TCL_ERROR) { + return TCL_ERROR; + } + + if (objc == 0) { + return TCL_OK; + } + + /* + * Configure evaluation context to match the requested flags. + */ + + if (flags) { + if (flags & TCL_EVAL_INVOKE) { + savedNsPtr = varFramePtr->nsPtr; + if (lookupNsPtr) { + varFramePtr->nsPtr = lookupNsPtr; + iPtr->lookupNsPtr = NULL; + } else { + varFramePtr->nsPtr = iPtr->globalNsPtr; + } + } else if ((flags & TCL_EVAL_GLOBAL) && (varFramePtr != iPtr->rootFramePtr) + && !savedVarFramePtr) { + varFramePtr = iPtr->rootFramePtr; + savedVarFramePtr = iPtr->varFramePtr; + iPtr->varFramePtr = varFramePtr; + } + } + + /* + * Find the function to execute this command. If there isn't one, or if + * there are traces, delegate to the full version. + */ + + cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]); + if (savedNsPtr) { + varFramePtr->nsPtr = savedNsPtr; + } + + if ((cmdPtr == NULL) || (iPtr->tracePtr != NULL) || + (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) { + /* + * Need the full version: command is either unknown or traced + */ + + if (savedVarFramePtr) { + iPtr->varFramePtr = savedVarFramePtr; + } + if (lookupNsPtr) { + iPtr->lookupNsPtr = lookupNsPtr; + } + return FullEvalObjvInternal(interp, objc, objv, command, length, flags); + } + + /* + * Finally, invoke the command's Tcl_ObjCmdProc. + */ + + cmdPtr->refCount++; + iPtr->cmdCount++; + + if (!TclLimitExceeded(iPtr->limit)) { + if (!(flags & TCL_EVAL_INVOKE) && + (iPtr->ensembleRewrite.sourceObjs != NULL)) { + iPtr->ensembleRewrite.sourceObjs = NULL; + } + code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv); + } + if (Tcl_AsyncReady()) { + code = Tcl_AsyncInvoke(interp, code); + } + if (code == TCL_OK && TclLimitReady(iPtr->limit)) { + code = Tcl_LimitCheck(interp); + } + + /* + * Decrement the reference count of cmdPtr and deallocate it if it has + * dropped to zero. + */ + + TclCleanupCommandMacro(cmdPtr); /* * If the interpreter has a non-empty string result, the result object is @@ -3666,7 +3801,6 @@ TclEvalObjvInternal( (void) Tcl_GetObjResult(interp); } - done: if (savedVarFramePtr) { iPtr->varFramePtr = savedVarFramePtr; } @@ -3676,77 +3810,44 @@ TclEvalObjvInternal( /* *---------------------------------------------------------------------- * - * Tcl_EvalObjv -- + * ProcessEvalObjvReturn -- * - * This function evaluates a Tcl command that has already been parsed - * into words, with one Tcl_Obj holding each word. + * This function does special handling for non TCL_OK returns from + * Tcl_EvalObjv. * * Results: * The return value is a standard Tcl completion code such as TCL_OK or * TCL_ERROR. A result or error message is left in interp's result. * * Side effects: - * Depends on the command. + * May alter the return code and/or generate an error log. * *---------------------------------------------------------------------- */ -int -Tcl_EvalObjv( +static int +ProcessEvalObjvReturn( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ int objc, /* Number of words in command. */ Tcl_Obj *const objv[], /* An array of pointers to objects that are * the words that make up the command. */ - int flags) /* Collection of OR-ed bits that control the - * evaluation of the script. Only - * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are - * currently supported. */ + int flags, + int code) /* The return code to be processed */ { Interp *iPtr = (Interp *) interp; - Trace *tracePtr; - Tcl_DString cmdBuf; - const char *cmdString = ""; /* A command string is only necessary for - * command traces or error logs; it will be - * generated to replace this default value if - * necessary. */ - int cmdLen = 0; /* A non-zero value indicates that a command - * string was generated. */ - int code = TCL_OK; - int i; int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS); - - for (tracePtr = iPtr->tracePtr; tracePtr; tracePtr = tracePtr->nextPtr) { - if ((tracePtr->level == 0) || (iPtr->numLevels <= tracePtr->level)) { - /* - * The command may be needed for an execution trace. Generate a - * command string. - */ - - Tcl_DStringInit(&cmdBuf); - for (i = 0; i < objc; i++) { - Tcl_DStringAppendElement(&cmdBuf, Tcl_GetString(objv[i])); - } - cmdString = Tcl_DStringValue(&cmdBuf); - cmdLen = Tcl_DStringLength(&cmdBuf); - break; - } - } - - iPtr->numLevels++; - code = TclEvalObjvInternal(interp, objc, objv, cmdString, cmdLen, flags); - iPtr->numLevels--; - + /* * If we are again at the top level, process any unusual return code * returned by the evaluated code. */ - + if (iPtr->numLevels == 0) { if (code == TCL_RETURN) { code = TclUpdateReturnInfo(iPtr); } - if ((code != TCL_OK) && (code != TCL_ERROR) && !allowExceptions) { + if ((code != TCL_ERROR) && !allowExceptions) { ProcessUnexpectedResult(interp, code); code = TCL_ERROR; } @@ -3755,29 +3856,70 @@ Tcl_EvalObjv( if ((code == TCL_ERROR) && !(flags & TCL_EVAL_INVOKE)) { /* * If there was an error, a command string will be needed for the - * error log: generate it now if it was not done previously. + * error log: generate it now. Do not worry too much about doing + * it expensively. */ - - if (cmdLen == 0) { - Tcl_DStringInit(&cmdBuf); - for (i = 0; i < objc; i++) { - Tcl_DStringAppendElement(&cmdBuf, Tcl_GetString(objv[i])); - } - cmdString = Tcl_DStringValue(&cmdBuf); - cmdLen = Tcl_DStringLength(&cmdBuf); - } + + Tcl_Obj *listPtr; + char *cmdString; + int cmdLen; + + listPtr = Tcl_NewListObj(objc, objv); + cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen); Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen); + Tcl_DecrRefCount(listPtr); } - if (cmdLen != 0) { - Tcl_DStringFree(&cmdBuf); - } return code; } /* *---------------------------------------------------------------------- * + * Tcl_EvalObjv -- + * + * This function evaluates a Tcl command that has already been parsed + * into words, with one Tcl_Obj holding each word. + * + * Results: + * The return value is a standard Tcl completion code such as TCL_OK or + * TCL_ERROR. A result or error message is left in interp's result. + * + * Side effects: + * Depends on the command. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_EvalObjv( + Tcl_Interp *interp, /* Interpreter in which to evaluate the + * command. Also used for error reporting. */ + int objc, /* Number of words in command. */ + Tcl_Obj *const objv[], /* An array of pointers to objects that are + * the words that make up the command. */ + int flags) /* Collection of OR-ed bits that control the + * evaluation of the script. Only + * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are + * currently supported. */ +{ + Interp *iPtr = (Interp *) interp; + int code = TCL_OK; + + iPtr->numLevels++; + code = TclEvalObjvInternal(interp, objc, objv, NULL, 0, flags); + iPtr->numLevels--; + + if (code == TCL_OK) { + return code; + } else { + return ProcessEvalObjvReturn(interp, objc, objv, flags, code); + } +} + +/* + *---------------------------------------------------------------------- + * * Tcl_EvalTokensStandard -- * * Given an array of tokens parsed from a Tcl command (e.g., the tokens diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 7531b99..f08333d 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.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: tclExecute.c,v 1.286 2007/06/05 17:50:55 msofer Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.287 2007/06/09 20:12:55 msofer Exp $ */ #include "tclInt.h" @@ -343,26 +343,6 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; #endif /* - * Inline version of Tcl_LimitReady() to limit number of calls out of this - * file in the critical path. Note that this code isn't particularly readable; - * the non-inline version (in tclInterp.c) is much easier to understand. Note - * also that this macro takes different args (iPtr->limit) to the non-inline - * version. - */ - -#define TclLimitReady(limit) \ - (((limit).active == 0) ? 0 : \ - (++(limit).granularityTicker, \ - ((((limit).active & TCL_LIMIT_COMMANDS) && \ - (((limit).cmdGranularity == 1) || \ - ((limit).granularityTicker % (limit).cmdGranularity == 0))) \ - ? 1 : \ - (((limit).active & TCL_LIMIT_TIME) && \ - (((limit).timeGranularity == 1) || \ - ((limit).granularityTicker % (limit).timeGranularity == 0)))\ - ? 1 : 0))) - -/* * Custom object type only used in this file; values of its type should never * be seen by user scripts. */ @@ -1646,26 +1626,7 @@ TclExecuteByteCode( iPtr->cmdCount += TclGetUInt4AtPtr(pc+5); if (!checkInterp) { instStartCmdOK: -#if 0 && !TCL_COMPILE_DEBUG - /* - * Peephole optimisations: check if there are several - * INST_START_CMD in a row. Many commands start by pushing a - * literal argument or command name; optimise that case too. - * - * TODO: Compiler no longer generates sequences of INST_START_CMD, - * so maybe take some of this peephole out. - */ - - while (*(pc += 9) == INST_START_CMD) { - iPtr->cmdCount += TclGetUInt4AtPtr(pc+5); - } - if (*pc == INST_PUSH1) { - goto instPush1Peephole; - } - NEXT_INST_F(0, 0, 0); -#else NEXT_INST_F(9, 0, 0); -#endif } else if (((codePtr->compileEpoch == iPtr->compileEpoch) && (codePtr->nsEpoch == namespacePtr->resolverEpoch)) || (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) { @@ -1959,7 +1920,7 @@ TclExecuteByteCode( iPtr->ensembleRewrite.sourceObjs = NULL; result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv); - TclCleanupCommand(cmdPtr); + TclCleanupCommandMacro(cmdPtr); if (Tcl_AsyncReady()) { result = Tcl_AsyncInvoke(interp, result); } @@ -6613,7 +6574,7 @@ TclExecuteByteCode( * is not exceeded) or we get to the top-level. */ - if (Tcl_LimitExceeded(interp)) { + if (TclLimitExceeded(iPtr->limit)) { #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { fprintf(stdout, " ... limit exceeded, returning %s\n", diff --git a/generic/tclInt.h b/generic/tclInt.h index ba41155..0387496 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.313 2007/06/05 17:57:07 dgp Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.314 2007/06/09 20:12:55 msofer Exp $ */ #ifndef _TCLINT @@ -3403,6 +3403,41 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum, #define TclIsNaN(d) ((d) != (d)) #endif +/* + *---------------------------------------------------------------- + * Inline version of TclCleanupCommand; still need the function as it is in + * the internal stubs, but the core can use the macro instead. + */ + +#define TclCleanupCommandMacro(cmdPtr) \ + if ((cmdPtr)->refCount <= 0) { \ + ckfree((char *) (cmdPtr));\ + } + +/* + *---------------------------------------------------------------- + * Inline versions of Tcl_LimitReady() and Tcl_LimitExceeded to limit number + * of calls out of the critical path. Note that this code isn't particularly + * readable; the non-inline version (in tclInterp.c) is much easier to + * understand. Note also that these macros takes different args (iPtr->limit) + * to the non-inline version. + */ + +#define TclLimitExceeded(limit) ((limit).exceeded != 0) + +#define TclLimitReady(limit) \ + (((limit).active == 0) ? 0 : \ + (++(limit).granularityTicker, \ + ((((limit).active & TCL_LIMIT_COMMANDS) && \ + (((limit).cmdGranularity == 1) || \ + ((limit).granularityTicker % (limit).cmdGranularity == 0))) \ + ? 1 : \ + (((limit).active & TCL_LIMIT_TIME) && \ + (((limit).timeGranularity == 1) || \ + ((limit).granularityTicker % (limit).timeGranularity == 0)))\ + ? 1 : 0))) + + #include "tclPort.h" #include "tclIntDecls.h" #include "tclIntPlatDecls.h" diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 8c32150..cfbdb6b 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.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: tclInterp.c,v 1.74 2007/05/17 12:05:22 dkf Exp $ + * RCS: @(#) $Id: tclInterp.c,v 1.75 2007/06/09 20:12:55 msofer Exp $ */ #include "tclInt.h" @@ -2904,6 +2904,9 @@ Tcl_MakeSafe( * Side effects: * None. * + * Notes: + * If you change this function, you MUST also update TclLimitExceeded() in + * tclInt.h. *---------------------------------------------------------------------- */ @@ -2933,7 +2936,7 @@ Tcl_LimitExceeded( * * Notes: * If you change this function, you MUST also update TclLimitReady() in - * tclExecute.c. + * tclInt.h. * *---------------------------------------------------------------------- */ diff --git a/generic/tclObj.c b/generic/tclObj.c index 3c95c52..36596c5 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.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: tclObj.c,v 1.122 2007/05/11 09:43:22 dkf Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.123 2007/06/09 20:12:55 msofer Exp $ */ #include "tclInt.h" @@ -3659,7 +3659,7 @@ FreeCmdNameInternalRep( */ Command *cmdPtr = resPtr->cmdPtr; - TclCleanupCommand(cmdPtr); + TclCleanupCommandMacro(cmdPtr); ckfree((char *) resPtr); } } diff --git a/generic/tclTrace.c b/generic/tclTrace.c index a575f04..7d6b667 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.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: tclTrace.c,v 1.37 2007/05/07 19:45:33 dgp Exp $ + * RCS: @(#) $Id: tclTrace.c,v 1.38 2007/06/09 20:12:55 msofer Exp $ */ #include "tclInt.h" @@ -1396,7 +1396,8 @@ int TclCheckExecutionTraces( Tcl_Interp *interp, /* The current interpreter. */ CONST char *command, /* Pointer to beginning of the current command - * string. */ + * string. If NULL, the string will be + * generated from (objc,objv) */ int numChars, /* The number of characters in 'command' which * are part of the command string. */ Command *cmdPtr, /* Points to command's Command struct. */ @@ -1412,11 +1413,24 @@ TclCheckExecutionTraces( int traceCode = TCL_OK; TraceCommandInfo* tcmdPtr; Tcl_InterpState state = NULL; + Tcl_Obj *commandPtr = NULL; - if (command == NULL || cmdPtr->tracePtr == NULL) { + if (cmdPtr->tracePtr == NULL) { return traceCode; } + /* + * Insure that we have a nul-terminated command string + */ + + if (!command) { + commandPtr = Tcl_NewListObj(objc, objv); + command = Tcl_GetStringFromObj(commandPtr, &numChars); + } else if ((numChars != -1) && (command[numChars] != '\0')) { + commandPtr = Tcl_NewStringObj(command, numChars); + command = TclGetString(commandPtr); + } + curLevel = iPtr->varFramePtr->level; active.nextPtr = iPtr->activeCmdTracePtr; @@ -1467,6 +1481,10 @@ TclCheckExecutionTraces( if (state) { (void) Tcl_RestoreInterpState(interp, state); } + + if (commandPtr) { + Tcl_DecrRefCount(commandPtr); + } return(traceCode); } @@ -1497,7 +1515,8 @@ int TclCheckInterpTraces( Tcl_Interp *interp, /* The current interpreter. */ CONST char *command, /* Pointer to beginning of the current command - * string. */ + * string. If NULL, the string will be + * generated from (objc,objv) */ int numChars, /* The number of characters in 'command' which * are part of the command string. */ Command *cmdPtr, /* Points to command's Command struct. */ @@ -1512,12 +1531,25 @@ TclCheckInterpTraces( int curLevel; int traceCode = TCL_OK; Tcl_InterpState state = NULL; + Tcl_Obj *commandPtr = NULL; - if (command == NULL || iPtr->tracePtr == NULL + if ((iPtr->tracePtr == NULL) || (iPtr->flags & INTERP_TRACE_IN_PROGRESS)) { return(traceCode); } + /* + * Insure that we have a nul-terminated command string + */ + + if (!command) { + commandPtr = Tcl_NewListObj(objc, objv); + command = Tcl_GetStringFromObj(commandPtr, &numChars); + } else if ((numChars != -1) && (command[numChars] != '\0')) { + commandPtr = Tcl_NewStringObj(command, numChars); + command = TclGetString(commandPtr); + } + curLevel = iPtr->numLevels; active.nextPtr = iPtr->activeInterpTracePtr; @@ -1615,6 +1647,10 @@ TclCheckInterpTraces( Tcl_DiscardInterpState(state); } } + + if (commandPtr) { + Tcl_DecrRefCount(commandPtr); + } return(traceCode); } |