Diff
Not logged in

Differences From Artifact [cb6cb9edf7]:

To Artifact [3c4c8fc08a]:


1
2
3
4
5
6
7
8
9
10
11
12
13
14

15
16
17
18
19
20
21
1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
21













-
+







/* 
 * tclTrace.c --
 *
 *	This file contains code to handle most trace management.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 Scriptics Corporation.
 * Copyright (c) 2002 ActiveState Corporation.
 *
 * 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.21.4.2 2005/04/12 21:10:04 msofer Exp $
 * RCS: @(#) $Id: tclTrace.c,v 1.21.4.3 2005/06/13 01:46:18 msofer Exp $
 */

#include "tclInt.h"

/*
 * Structure used to hold information about variable traces:
 */
58
59
60
61
62
63
64
65
66


67
68
69
70
71
72
73
58
59
60
61
62
63
64


65
66
67
68
69
70
71
72
73







-
-
+
+







				 * hold command.  This field must be the
				 * last in the structure, so that it can
				 * be larger than 4 bytes. */
} TraceCommandInfo;

/* 
 * Used by command execution traces.  Note that we assume in the code
 * that the first two defines are exactly 4 times the
 * 'TCL_TRACE_ENTER_EXEC' and 'TCL_TRACE_LEAVE_EXEC' constants.
 * that TCL_TRACE_ENTER_DURING_EXEC == 4 * TCL_TRACE_ENTER_EXEC and
 * that TCL_TRACE_LEAVE_DURING_EXEC == 4 * TCL_TRACE_LEAVE_EXEC.
 * 
 * TCL_TRACE_ENTER_DURING_EXEC  - Trace each command inside the command
 *                                currently being traced, before execution.
 * TCL_TRACE_LEAVE_DURING_EXEC  - Trace each command inside the command
 *                                currently being traced, after execution.
 * TCL_TRACE_ANY_EXEC           - OR'd combination of all EXEC flags.
 * TCL_TRACE_EXEC_IN_PROGRESS   - The callback procedure on this trace
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1458
1459
1460
1461
1462
1463
1464

1465
1466
1467
1468
1469
1470
1471







-







    Tcl_Obj *CONST objv[];	/* Pointers to Tcl_Obj of each argument. */
{
    Interp *iPtr = (Interp *) interp;
    Trace *tracePtr, *lastTracePtr;
    ActiveInterpTrace active;
    int curLevel;
    int traceCode = TCL_OK;
    TraceCommandInfo* tcmdPtr;
    Tcl_InterpState state = NULL;
    
    if (command == NULL || iPtr->tracePtr == NULL ||
           (iPtr->flags & INTERP_TRACE_IN_PROGRESS)) {
	return(traceCode);
    }
    
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524








1525
1526

1527
1528

1529
1530
1531
1532
1533
1534
1535
1511
1512
1513
1514
1515
1516
1517






1518
1519
1520
1521
1522
1523
1524
1525


1526


1527
1528
1529
1530
1531
1532
1533
1534







-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
+
-
-
+







	    tracePtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS;
	    if (state == NULL) {
		state = Tcl_SaveInterpState(interp, code);
	    }
	    
	    if (tracePtr->flags & (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC)) {
	        /* New style trace */
		if ((tracePtr->flags != TCL_TRACE_EXEC_IN_PROGRESS) &&
		    ((tracePtr->flags & traceFlags) != 0)) {
		    tcmdPtr = (TraceCommandInfo*)tracePtr->clientData;
		    tcmdPtr->curFlags = traceFlags;
		    tcmdPtr->curCode  = code;
		    traceCode = (tracePtr->proc)((ClientData)tcmdPtr, 
		if (tracePtr->flags & traceFlags) {
		    if (tracePtr->proc == TraceExecutionProc) {
			TraceCommandInfo* tcmdPtr =
				(TraceCommandInfo *) tracePtr->clientData;
			tcmdPtr->curFlags = traceFlags;
			tcmdPtr->curCode  = code;
		    }
		    traceCode = (tracePtr->proc)(tracePtr->clientData,
						 (Tcl_Interp*)interp,
						 curLevel, command,
			    interp, curLevel, command, (Tcl_Command) cmdPtr,
						 (Tcl_Command)cmdPtr,
						 objc, objv);
			    objc, objv);
		}
	    } else {
		/* Old-style trace */
		
		if (traceFlags & TCL_TRACE_ENTER_EXEC) {
		    /* 
		     * Old-style interpreter-wide traces only trigger