summaryrefslogtreecommitdiffstats
path: root/generic/tclTrace.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclTrace.c')
-rw-r--r--generic/tclTrace.c122
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) {
generated by cgit v0.12 at 2024-11-09 19:21:26 (GMT)