diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | generic/tclBasic.c | 55 | ||||
| -rw-r--r-- | generic/tclExecute.c | 50 | ||||
| -rw-r--r-- | generic/tclInt.h | 3 | ||||
| -rw-r--r-- | generic/tclTrace.c | 37 |
5 files changed, 80 insertions, 73 deletions
@@ -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); } |