summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2007-06-09 20:12:53 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2007-06-09 20:12:53 (GMT)
commita4338c631ef67bfe928e7764ab1fc89d0a3a2e62 (patch)
treec9cb6877f88fcbfad1512aa0fd12c16dc9738a77
parentc17b51664c1993d118f7a0611afc339d8e84d1c3 (diff)
downloadtcl-a4338c631ef67bfe928e7764ab1fc89d0a3a2e62.zip
tcl-a4338c631ef67bfe928e7764ab1fc89d0a3a2e62.tar.gz
tcl-a4338c631ef67bfe928e7764ab1fc89d0a3a2e62.tar.bz2
* 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:
-rw-r--r--ChangeLog23
-rw-r--r--generic/tclBasic.c356
-rw-r--r--generic/tclExecute.c45
-rw-r--r--generic/tclInt.h37
-rw-r--r--generic/tclInterp.c7
-rw-r--r--generic/tclObj.c4
-rw-r--r--generic/tclTrace.c46
7 files changed, 359 insertions, 159 deletions
diff --git a/ChangeLog b/ChangeLog
index 10e9dcb..0bfcb88 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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);
}