diff options
author | dgp <dgp@users.sourceforge.net> | 2004-10-19 21:53:47 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2004-10-19 21:53:47 (GMT) |
commit | ff2e42113f72c49be25be40042c28571c3a97c30 (patch) | |
tree | b5e581d2da471e1291e0dcb7cd21a9c3d2ff09d3 /generic/tclTrace.c | |
parent | c1d97ce12a7418450665a45cf72e0e220fbf742e (diff) | |
download | tcl-ff2e42113f72c49be25be40042c28571c3a97c30.zip tcl-ff2e42113f72c49be25be40042c28571c3a97c30.tar.gz tcl-ff2e42113f72c49be25be40042c28571c3a97c30.tar.bz2 |
* generic/tclInt.h (Tcl*InterpState): New internal routines
* generic/tclResult.c (Tcl*InterpState): TclSaveInterpState,
TclRestoreInterpState, and TclDiscardInterpState are superior
replacements for Tcl_(Save|Restore|Discard)Result. Intent is that
these routines will be converted to public routines after TIP approval.
* generic/tclBasic.c (TclEvalObjvInternal):
* generic/tclDictObj.c (DictUpdateCmd, DictWithCmd):
* generic/tclIOGT.c (ExecuteCallback):
* generic/tclTrace.c (Trace*Proc,TclCheck*Traces,TclCallVarTraces):
Callers of Tcl_*Result updated to call the new routines. The
calls were relocated in several cases to perform save/restore
operations only when needed.
* generic/tclEvent.c (HandleBgErrors):
* generic/tclFCmd.c (CopyRenameOneFile):
Calls to Tcl_*Result that were eliminated because they appeared
to serve no useful purpose, typically saving/restoring an error
message, only to throw it away.
Diffstat (limited to 'generic/tclTrace.c')
-rw-r--r-- | generic/tclTrace.c | 122 |
1 files changed, 41 insertions, 81 deletions
diff --git a/generic/tclTrace.c b/generic/tclTrace.c index b2067b3..3d5e835 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.16 2004/10/15 04:01:33 dgp Exp $ + * RCS: @(#) $Id: tclTrace.c,v 1.17 2004/10/19 21:54:07 dgp Exp $ */ #include "tclInt.h" @@ -1286,9 +1286,6 @@ TraceCommandProc(clientData, interp, oldName, newName, flags) int flags; /* OR-ed bits giving operation and other * information. */ { - Interp *iPtr = (Interp *) interp; - Tcl_Obj *stateReturnOpts; - Tcl_SavedResult state; TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData; int code; Tcl_DString cmd; @@ -1313,38 +1310,23 @@ TraceCommandProc(clientData, interp, oldName, newName, flags) } /* - * Execute the command. Save the interp's result used for the - * command, including the value of iPtr->returnOpts which may be - * modified when Tcl_Eval is invoked. We discard any object - * result the command returns. + * Execute the command. + * We discard any object result the command returns. * * Add the TCL_TRACE_DESTROYED flag to tcmdPtr to indicate to * other areas that this will be destroyed by us, otherwise a * double-free might occur depending on what the eval does. */ - Tcl_SaveResult(interp, &state); - stateReturnOpts = iPtr->returnOpts; - Tcl_IncrRefCount(stateReturnOpts); if (flags & TCL_TRACE_DESTROYED) { tcmdPtr->flags |= TCL_TRACE_DESTROYED; } - code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), Tcl_DStringLength(&cmd), 0); if (code != TCL_OK) { /* We ignore errors in these traced commands */ /*** QUESTION: Use Tcl_BackgroundError(interp); instead? ***/ } - - Tcl_RestoreResult(interp, &state); - if (iPtr->returnOpts != stateReturnOpts) { - Tcl_DecrRefCount(iPtr->returnOpts); - iPtr->returnOpts = stateReturnOpts; - Tcl_IncrRefCount(iPtr->returnOpts); - } - Tcl_DecrRefCount(stateReturnOpts); - Tcl_DStringFree(&cmd); } /* @@ -1440,6 +1422,7 @@ TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code, int curLevel; int traceCode = TCL_OK; TraceCommandInfo* tcmdPtr; + TclInterpState state = NULL; if (command == NULL || cmdPtr->tracePtr == NULL) { return traceCode; @@ -1471,6 +1454,9 @@ TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code, tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT; tcmdPtr->curCode = code; tcmdPtr->refCount++; + if (state == NULL) { + state = TclSaveInterpState(interp, code); + } traceCode = TraceExecutionProc((ClientData)tcmdPtr, interp, curLevel, command, (Tcl_Command)cmdPtr, objc, objv); if ((--tcmdPtr->refCount) <= 0) { @@ -1480,6 +1466,9 @@ TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code, lastTracePtr = tracePtr; } iPtr->activeCmdTracePtr = active.nextPtr; + if (state) { + (void) TclRestoreInterpState(interp, state); + } return(traceCode); } @@ -1525,6 +1514,7 @@ TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, int curLevel; int traceCode = TCL_OK; TraceCommandInfo* tcmdPtr; + TclInterpState state = NULL; if (command == NULL || iPtr->tracePtr == NULL || (iPtr->flags & INTERP_TRACE_IN_PROGRESS)) { @@ -1571,6 +1561,9 @@ TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, */ Tcl_Preserve((ClientData) tracePtr); tracePtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS; + if (state == NULL) { + state = TclSaveInterpState(interp, code); + } if (tracePtr->flags & (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC)) { /* New style trace */ @@ -1603,6 +1596,13 @@ TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, lastTracePtr = tracePtr; } iPtr->activeInterpTracePtr = active.nextPtr; + if (state) { + if (traceCode == TCL_OK) { + (void) TclRestoreInterpState(interp, state); + } else { + TclDiscardInterpState(state); + } + } return(traceCode); } @@ -1765,8 +1765,6 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp, * Second, create the tcl callback, if required. */ if (call) { - Tcl_SavedResult state; - Tcl_Obj *stateReturnOpts; Tcl_DString cmd; Tcl_DString sub; int i; @@ -1814,16 +1812,10 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp, } /* - * Execute the command. Save the interp's result used for - * the command, including the value of iPtr->returnOpts which - * may be modified when Tcl_Eval is invoked. We discard any - * object result the command returns. + * Execute the command. + * We discard any object result the command returns. */ - Tcl_SaveResult(interp, &state); - stateReturnOpts = iPtr->returnOpts; - Tcl_IncrRefCount(stateReturnOpts); - tcmdPtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS; iPtr->flags |= INTERP_TRACE_IN_PROGRESS; tcmdPtr->refCount++; @@ -1838,20 +1830,6 @@ TraceExecutionProc(ClientData clientData, Tcl_Interp *interp, if (tcmdPtr->flags == 0) { flags |= TCL_TRACE_DESTROYED; } - - if (traceCode == TCL_OK) { - /* Restore result if trace execution was successful */ - Tcl_RestoreResult(interp, &state); - if (iPtr->returnOpts != stateReturnOpts) { - Tcl_DecrRefCount(iPtr->returnOpts); - iPtr->returnOpts = stateReturnOpts; - Tcl_IncrRefCount(iPtr->returnOpts); - } - } else { - Tcl_DiscardResult(&state); - } - Tcl_DecrRefCount(stateReturnOpts); - Tcl_DStringFree(&cmd); } @@ -1923,7 +1901,6 @@ TraceVarProc(clientData, interp, name1, name2, flags) int flags; /* OR-ed bits giving operation and other * information. */ { - Tcl_SavedResult state; TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData; char *result; int code; @@ -1979,19 +1956,17 @@ TraceVarProc(clientData, interp, name1, name2, flags) #endif /* - * Execute the command. Save the interp's result used for - * the command. We discard any object result the command returns. + * Execute the command. + * We discard any object result the command returns. * * Add the TCL_TRACE_DESTROYED flag to tvarPtr to indicate to * other areas that this will be destroyed by us, otherwise a * double-free might occur depending on what the eval does. */ - Tcl_SaveResult(interp, &state); if (flags & TCL_TRACE_DESTROYED) { tvarPtr->flags |= TCL_TRACE_DESTROYED; } - code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), Tcl_DStringLength(&cmd), 0); if (code != TCL_OK) { /* copy error msg to result */ @@ -1999,9 +1974,6 @@ TraceVarProc(clientData, interp, name1, name2, flags) Tcl_IncrRefCount(errMsgObj); result = (char *) errMsgObj; } - - Tcl_RestoreResult(interp, &state); - Tcl_DStringFree(&cmd); } } @@ -2450,16 +2422,7 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg) int copiedName; int code = TCL_OK; int disposeFlags = 0; - int saveErrFlags = iPtr->flags & ERR_ALREADY_LOGGED; - Tcl_Obj *saveErrInfo = iPtr->errorInfo; - Tcl_Obj *saveErrCode = iPtr->errorCode; - - if (saveErrInfo) { - Tcl_IncrRefCount(saveErrInfo); - } - if (saveErrCode) { - Tcl_IncrRefCount(saveErrCode); - } + TclInterpState state = NULL; /* * If there are already similar trace procedures active for the @@ -2526,6 +2489,9 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg) continue; } Tcl_Preserve((ClientData) tracePtr); + if (state == NULL) { + state = TclSaveInterpState((Tcl_Interp *)iPtr, code); + } result = (*tracePtr->traceProc)(tracePtr->clientData, (Tcl_Interp *) iPtr, part1, part2, flags); if (result != NULL) { @@ -2559,6 +2525,9 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg) continue; } Tcl_Preserve((ClientData) tracePtr); + if (state == NULL) { + state = TclSaveInterpState((Tcl_Interp *)iPtr, code); + } result = (*tracePtr->traceProc)(tracePtr->clientData, (Tcl_Interp *) iPtr, part1, part2, flags); if (result != NULL) { @@ -2582,24 +2551,6 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg) */ done: - if (code == TCL_OK) { - iPtr->flags |= saveErrFlags; - if (iPtr->errorInfo) { - Tcl_DecrRefCount(iPtr->errorInfo); - } - iPtr->errorInfo = saveErrInfo; - if (iPtr->errorCode) { - Tcl_DecrRefCount(iPtr->errorCode); - } - iPtr->errorCode = saveErrCode; - } else { - if (saveErrInfo) { - Tcl_DecrRefCount(saveErrInfo); - } - if (saveErrCode) { - Tcl_DecrRefCount(saveErrCode); - } - } if (code == TCL_ERROR) { if (leaveErrMsg) { CONST char *type = ""; @@ -2623,8 +2574,17 @@ TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg) } else { TclVarErrMsg((Tcl_Interp *) iPtr, part1, part2, type, result); } + TclDiscardInterpState(state); + } else { + (void) TclRestoreInterpState((Tcl_Interp *)iPtr, state); } DisposeTraceResult(disposeFlags,result); + } else if (state) { + if (code == TCL_OK) { + code = TclRestoreInterpState((Tcl_Interp *)iPtr, state); + } else { + TclDiscardInterpState(state); + } } if (arrayPtr != NULL) { |