summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2007-07-24 03:05:51 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2007-07-24 03:05:51 (GMT)
commit6abdd3f848d11dc37978bfbfd7025827862dd112 (patch)
tree756cc271c52d04021ba9eaf8b3034d00fbf3d151
parent5785bb0ff0458af7bc55bc79cf0f83bb21cebe7d (diff)
downloadtcl-6abdd3f848d11dc37978bfbfd7025827862dd112.zip
tcl-6abdd3f848d11dc37978bfbfd7025827862dd112.tar.gz
tcl-6abdd3f848d11dc37978bfbfd7025827862dd112.tar.bz2
* generic/tclBasic.c (TEOvI, GetCommandSource):
* generic/tclExecute.c (TEBC, TclGetSrcInfoForCmd): * generic/tclInt.h: * generic/tclTrace.c (TclCheck(Interp|Execution)Traces): Removed the need for TEBC to inspect the command before calling TEOvI, leveraging the TIP 282 infrastructure. Moved the generation of a correct nul-terminated command string away from the trace code, back into TEOvI/GetCommandSource.
-rw-r--r--ChangeLog8
-rw-r--r--generic/tclBasic.c55
-rw-r--r--generic/tclExecute.c50
-rw-r--r--generic/tclInt.h3
-rw-r--r--generic/tclTrace.c37
5 files changed, 80 insertions, 73 deletions
diff --git a/ChangeLog b/ChangeLog
index 494c538..c0d1a5c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2007-07-24 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclBasic.c (TEOvI, GetCommandSource):
+ * generic/tclExecute.c (TEBC, TclGetSrcInfoForCmd):
+ * generic/tclInt.h:
+ Removed the need for TEBC to inspect the command before calling
+ TEOvI, leveraging the TIP 282 infrastructure.
+
2007-07-20 Andreas Kupries <andreask@activestate.com>
* library/platform/platform.tcl: Fixed bug in 'platform::patterns'
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 760a92c..3f7c983 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.262 2007/06/29 03:16:01 das Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.263 2007/07/24 03:05:53 msofer Exp $
*/
#include "tclInt.h"
@@ -54,6 +54,8 @@ static char * CallCommandTraces(Interp *iPtr, Command *cmdPtr,
static int CheckDoubleResult(Tcl_Interp *interp, double dResult);
static void DeleteInterpProc(Tcl_Interp *interp);
static void DeleteOpCmdClientData(ClientData clientData);
+static Tcl_Obj *GetCommandSource(Interp *iPtr, const char *command,
+ int numChars, int objc, Tcl_Obj *const objv[]);
static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode);
static int OldMathFuncProc(ClientData clientData, Tcl_Interp *interp,
int argc, Tcl_Obj *const *objv);
@@ -2863,6 +2865,40 @@ CallCommandTraces(
Tcl_Release((ClientData) iPtr);
return result;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetCommandSource --
+ *
+ * This function returns a Tcl_Obj with the full source string for the
+ * command. This insures that traces get a correct nul-terminated command
+ * string.
+ *
+ */
+
+static Tcl_Obj *
+GetCommandSource(
+ Interp *iPtr,
+ const char *command,
+ int numChars,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_Obj *commandPtr;
+
+ if (!command) {
+ commandPtr = Tcl_NewListObj(objc, objv);
+ } else {
+ if (command == (char *) -1) {
+ command = TclGetSrcInfoForCmd(iPtr, &numChars);
+ }
+ commandPtr = Tcl_NewStringObj(command, numChars);
+ }
+
+ return commandPtr;
+}
+
/*
*----------------------------------------------------------------------
@@ -3358,7 +3394,9 @@ TclEvalObjvInternal(
* 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).*/
+ * to be generated from (objc,objv), -1 if it
+ * is to be generated from bytecode
+ * source. This is only needed the traces. */
int length, /* Number of bytes in command; if -1, all
* characters up to the first null byte are
* used. */
@@ -3378,7 +3416,7 @@ TclEvalObjvInternal(
int checkTraces = 1, traced;
Namespace *savedNsPtr = NULL;
Namespace *lookupNsPtr = iPtr->lookupNsPtr;
-
+ Tcl_Obj *commandPtr = NULL;
if (TclInterpReady(interp) == TCL_ERROR) {
return TCL_ERROR;
@@ -3449,6 +3487,14 @@ TclEvalObjvInternal(
int newEpoch;
/*
+ * Insure that we have a correct nul-terminated command string for the
+ * trace code.
+ */
+
+ commandPtr = GetCommandSource(iPtr, command, length, objc, objv);
+ command = Tcl_GetStringFromObj(commandPtr, &length);
+
+ /*
* Execute any command or execution traces. Note that we bump up the
* command's reference count for the duration of the calling of the
* traces so that the structure doesn't go away underneath our feet.
@@ -3521,6 +3567,9 @@ TclEvalObjvInternal(
if (traceCode != TCL_OK) {
code = traceCode;
}
+ if (commandPtr) {
+ Tcl_DecrRefCount(commandPtr);
+ }
}
/*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 63096ec..fb4570e 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.305 2007/06/28 21:24:56 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.306 2007/07/24 03:05:53 msofer Exp $
*/
#include "tclInt.h"
@@ -1975,7 +1975,6 @@ TclExecuteByteCode(
doInvocation:
{
Tcl_Obj **objv = &OBJ_AT_DEPTH(objc-1);
- Command *cmdPtr;
#ifdef TCL_COMPILE_DEBUG
if (tclTraceExec >= 2) {
@@ -2014,37 +2013,8 @@ TclExecuteByteCode(
bcFramePtr->data.tebc.pc = (char *) pc;
iPtr->cmdFramePtr = bcFramePtr;
DECACHE_STACK_INFO();
- cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
-
- if (cmdPtr
- && !((cmdPtr->flags & CMD_HAS_EXEC_TRACES) || iPtr->tracePtr)
- && !(checkInterp && (codePtr->compileEpoch != iPtr->compileEpoch))
- ) {
- cmdPtr->refCount++;
- iPtr->cmdCount++;
- result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
-
- if (Tcl_AsyncReady()) {
- result = Tcl_AsyncInvoke(interp, result);
- }
- if (result == TCL_OK && TclLimitReady(iPtr->limit)) {
- result = Tcl_LimitCheck(interp);
- }
- TclCleanupCommandMacro(cmdPtr);
- } else {
- /*
- * If trace procedures will be called, we need a command
- * string to pass to TclEvalObjvInternal; note that a copy of
- * the string will be made there to include the ending \0.
- */
- int length;
- const char *bytes;
-
- bytes = GetSrcInfoForPc(pc, codePtr, &length);
- result = TclEvalObjvInternal(interp, objc, objv, bytes,
- length, 0);
- }
-
+ result = TclEvalObjvInternal(interp, objc, objv,
+ /* call from TEBC */(char *) -1, -1, 0);
CACHE_STACK_INFO();
iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
@@ -6858,7 +6828,7 @@ IllegalExprOperandType(
/*
*----------------------------------------------------------------------
*
- * TclGetSrcInfoForPc, GetSrcInfoForPc --
+ * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSrcInfoForCmd --
*
* Given a program counter value, finds the closest command in the
* bytecode code unit's CmdLocation array and returns information about
@@ -6879,6 +6849,18 @@ IllegalExprOperandType(
*----------------------------------------------------------------------
*/
+const char *
+TclGetSrcInfoForCmd(
+ Interp *iPtr,
+ int *lenPtr)
+{
+ CmdFrame *cfPtr = iPtr->cmdFramePtr;
+ ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
+
+ return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc,
+ codePtr, lenPtr);
+}
+
void
TclGetSrcInfoForPc(
CmdFrame *cfPtr)
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 435f6bd..7ab0750 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.323 2007/07/02 17:32:09 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.324 2007/07/24 03:05:53 msofer Exp $
*/
#ifndef _TCLINT
@@ -2289,6 +2289,7 @@ MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp,
CONST char *modeString, int *seekFlagPtr,
int *binaryPtr);
MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
+MODULE_SCOPE const char *TclGetSrcInfoForCmd(Interp *iPtr, int *lenPtr);
MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern,
Tcl_Obj *unquotedPrefix, int globFlags,
Tcl_GlobTypeData *types);
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 638893f..a0c777c 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.41 2007/06/28 21:10:38 patthoyts Exp $
+ * RCS: @(#) $Id: tclTrace.c,v 1.42 2007/07/24 03:05:53 msofer Exp $
*/
#include "tclInt.h"
@@ -1413,24 +1413,11 @@ TclCheckExecutionTraces(
int traceCode = TCL_OK;
TraceCommandInfo* tcmdPtr;
Tcl_InterpState state = NULL;
- Tcl_Obj *commandPtr = 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;
@@ -1482,9 +1469,6 @@ TclCheckExecutionTraces(
(void) Tcl_RestoreInterpState(interp, state);
}
- if (commandPtr) {
- Tcl_DecrRefCount(commandPtr);
- }
return(traceCode);
}
@@ -1515,8 +1499,7 @@ int
TclCheckInterpTraces(
Tcl_Interp *interp, /* The current interpreter. */
CONST char *command, /* Pointer to beginning of the current command
- * string. If NULL, the string will be
- * generated from (objc,objv) */
+ * string. */
int numChars, /* The number of characters in 'command' which
* are part of the command string. */
Command *cmdPtr, /* Points to command's Command struct. */
@@ -1531,25 +1514,12 @@ TclCheckInterpTraces(
int curLevel;
int traceCode = TCL_OK;
Tcl_InterpState state = NULL;
- Tcl_Obj *commandPtr = 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;
@@ -1648,9 +1618,6 @@ TclCheckInterpTraces(
}
}
- if (commandPtr) {
- Tcl_DecrRefCount(commandPtr);
- }
return(traceCode);
}