Tcl Source Code

Check-in [32e489acdc]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Changes to the code: remove the macro "TCL_REMOVE_OBSOLETE_TRACES" and associated code. Turn the [trace] command into an ensemble.

Note: the tests show that not all is well yet, basic-15.2 for instance fails -- the [trace] command complains about an invalid operation "::deleter", but if I run the test manually, that is, by typing the commands into an interactive tclsh based on the new code, then it proceeds without a failure. (The invocation of [trace] comes from the [history] command)

Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | am-trace-ensemble
Files: files | file ages | folders
SHA3-256: 32e489acdc68a73e31cd4d17e73cf25476f5f7411e031ffa91cfdd0304144df0
User & Date: arjenmarkus 2018-05-08 17:38:23
Context
2018-05-08
17:51
Remove the obsolete form of the [trace] command from the documentation. check-in: 559d647aca user: arjenmarkus tags: am-trace-ensemble
17:38
Changes to the code: remove the macro "TCL_REMOVE_OBSOLETE_TRACES" and associated code. Turn the [t... check-in: 32e489acdc user: arjenmarkus tags: am-trace-ensemble
2018-05-03
07:12
Adjust the tests that use the old-style trace command. This is a preparation for the modernisation o... check-in: b0aff011b2 user: markus tags: am-trace-ensemble
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tcl.h.

902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
#define TCL_TRACE_READS		 0x10
#define TCL_TRACE_WRITES	 0x20
#define TCL_TRACE_UNSETS	 0x40
#define TCL_TRACE_DESTROYED	 0x80
#define TCL_INTERP_DESTROYED	 0x100
#define TCL_LEAVE_ERR_MSG	 0x200
#define TCL_TRACE_ARRAY		 0x800
#ifndef TCL_REMOVE_OBSOLETE_TRACES
/* Required to support old variable/vdelete/vinfo traces. */
#define TCL_TRACE_OLD_STYLE	 0x1000
#endif
/* Indicate the semantics of the result of a trace. */
#define TCL_TRACE_RESULT_DYNAMIC 0x8000
#define TCL_TRACE_RESULT_OBJECT  0x10000

/*
 * Flag values for ensemble commands.
 */






<
<
<
<







902
903
904
905
906
907
908




909
910
911
912
913
914
915
#define TCL_TRACE_READS		 0x10
#define TCL_TRACE_WRITES	 0x20
#define TCL_TRACE_UNSETS	 0x40
#define TCL_TRACE_DESTROYED	 0x80
#define TCL_INTERP_DESTROYED	 0x100
#define TCL_LEAVE_ERR_MSG	 0x200
#define TCL_TRACE_ARRAY		 0x800




/* Indicate the semantics of the result of a trace. */
#define TCL_TRACE_RESULT_DYNAMIC 0x8000
#define TCL_TRACE_RESULT_OBJECT  0x10000

/*
 * Flag values for ensemble commands.
 */

Changes to generic/tclBasic.c.

228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
...
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
...
789
790
791
792
793
794
795






796
797
798
799
800
801
802
    {"scan",		Tcl_ScanObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"set",		Tcl_SetObjCmd,		TclCompileSetCmd,	NULL,	CMD_IS_SAFE},
    {"split",		Tcl_SplitObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"subst",		Tcl_SubstObjCmd,	TclCompileSubstCmd,	TclNRSubstObjCmd,	CMD_IS_SAFE},
    {"switch",		Tcl_SwitchObjCmd,	TclCompileSwitchCmd,	TclNRSwitchObjCmd, CMD_IS_SAFE},
    {"tailcall",	NULL,			TclCompileTailcallCmd,	TclNRTailcallObjCmd,	CMD_IS_SAFE},
    {"throw",		Tcl_ThrowObjCmd,	TclCompileThrowCmd,	NULL,	CMD_IS_SAFE},
    {"trace",		Tcl_TraceObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"try",		Tcl_TryObjCmd,		TclCompileTryCmd,	TclNRTryObjCmd,	CMD_IS_SAFE},
    {"unset",		Tcl_UnsetObjCmd,	TclCompileUnsetCmd,	NULL,	CMD_IS_SAFE},
    {"uplevel",		Tcl_UplevelObjCmd,	NULL,			TclNRUplevelObjCmd,	CMD_IS_SAFE},
    {"upvar",		Tcl_UpvarObjCmd,	TclCompileUpvarCmd,	NULL,	CMD_IS_SAFE},
    {"variable",	Tcl_VariableObjCmd,	TclCompileVariableCmd,	NULL,	CMD_IS_SAFE},
    {"while",		Tcl_WhileObjCmd,	TclCompileWhileCmd,	TclNRWhileObjCmd,	CMD_IS_SAFE},
    {"yield",		NULL,			TclCompileYieldCmd,	TclNRYieldObjCmd,	CMD_IS_SAFE},
................................................................................
	    cmdPtr->nreProc = cmdInfoPtr->nreProc;
	    Tcl_SetHashValue(hPtr, cmdPtr);
	}
    }

    /*
     * Create the "array", "binary", "chan", "clock", "dict", "encoding",
     * "file", "info", "namespace" and "string" ensembles. Note that all these
     * commands (and their subcommands that are not present in the global
     * namespace) are wholly safe *except* for "clock", "encoding" and "file".
     */

    TclInitArrayCmd(interp);
    TclInitBinaryCmd(interp);
    TclInitChanCmd(interp);
................................................................................
     * Register "clock" subcommands. These *do* go through
     * Tcl_CreateObjCommand, since they aren't in the global namespace and
     * involve ensembles.
     */

    TclClockInit(interp);







    /*
     * Register the built-in functions. This is empty now that they are
     * implemented as commands in the ::tcl::mathfunc namespace.
     */

    /*
     * Register the default [interp bgerror] handler.






<







 







|







 







>
>
>
>
>
>







228
229
230
231
232
233
234

235
236
237
238
239
240
241
...
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
...
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
    {"scan",		Tcl_ScanObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"set",		Tcl_SetObjCmd,		TclCompileSetCmd,	NULL,	CMD_IS_SAFE},
    {"split",		Tcl_SplitObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"subst",		Tcl_SubstObjCmd,	TclCompileSubstCmd,	TclNRSubstObjCmd,	CMD_IS_SAFE},
    {"switch",		Tcl_SwitchObjCmd,	TclCompileSwitchCmd,	TclNRSwitchObjCmd, CMD_IS_SAFE},
    {"tailcall",	NULL,			TclCompileTailcallCmd,	TclNRTailcallObjCmd,	CMD_IS_SAFE},
    {"throw",		Tcl_ThrowObjCmd,	TclCompileThrowCmd,	NULL,	CMD_IS_SAFE},

    {"try",		Tcl_TryObjCmd,		TclCompileTryCmd,	TclNRTryObjCmd,	CMD_IS_SAFE},
    {"unset",		Tcl_UnsetObjCmd,	TclCompileUnsetCmd,	NULL,	CMD_IS_SAFE},
    {"uplevel",		Tcl_UplevelObjCmd,	NULL,			TclNRUplevelObjCmd,	CMD_IS_SAFE},
    {"upvar",		Tcl_UpvarObjCmd,	TclCompileUpvarCmd,	NULL,	CMD_IS_SAFE},
    {"variable",	Tcl_VariableObjCmd,	TclCompileVariableCmd,	NULL,	CMD_IS_SAFE},
    {"while",		Tcl_WhileObjCmd,	TclCompileWhileCmd,	TclNRWhileObjCmd,	CMD_IS_SAFE},
    {"yield",		NULL,			TclCompileYieldCmd,	TclNRYieldObjCmd,	CMD_IS_SAFE},
................................................................................
	    cmdPtr->nreProc = cmdInfoPtr->nreProc;
	    Tcl_SetHashValue(hPtr, cmdPtr);
	}
    }

    /*
     * Create the "array", "binary", "chan", "clock", "dict", "encoding",
     * "file", "info", "namespace", "string" and "trace" ensembles. Note that all these
     * commands (and their subcommands that are not present in the global
     * namespace) are wholly safe *except* for "clock", "encoding" and "file".
     */

    TclInitArrayCmd(interp);
    TclInitBinaryCmd(interp);
    TclInitChanCmd(interp);
................................................................................
     * Register "clock" subcommands. These *do* go through
     * Tcl_CreateObjCommand, since they aren't in the global namespace and
     * involve ensembles.
     */

    TclClockInit(interp);

    /*
     * Register "trace" subcommands - modelled after the "clock" ensemble
     */

    TclTraceInit(interp);

    /*
     * Register the built-in functions. This is empty now that they are
     * implemented as commands in the ::tcl::mathfunc namespace.
     */

    /*
     * Register the default [interp bgerror] handler.

Changes to generic/tclInt.h.

3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
....
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ThrowObjCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TimeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TraceObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TryObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UnloadObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UnsetObjCmd(ClientData clientData,
................................................................................

typedef enum TclProcessWaitStatus {
    TCL_PROCESS_ERROR = -1,	/* Error waiting for process to exit */
    TCL_PROCESS_UNCHANGED = 0,	/* No change since the last call. */
    TCL_PROCESS_EXITED = 1,	/* Process has exited. */
    TCL_PROCESS_SIGNALED = 2,	/* Child killed because of a signal. */
    TCL_PROCESS_STOPPED = 3,	/* Child suspended because of a signal. */
    TCL_PROCESS_UNKNOWN_STATUS = 4 
				/* Child wait status didn't make sense. */
} TclProcessWaitStatus;

MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp);
MODULE_SCOPE void	TclProcessCreated(Tcl_Pid pid);
MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
			    int *codePtr, Tcl_Obj **msgObjPtr,






|
<
<







 







|







3426
3427
3428
3429
3430
3431
3432
3433


3434
3435
3436
3437
3438
3439
3440
....
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ThrowObjCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TimeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE void	TclTraceInit(Tcl_Interp *interp);


MODULE_SCOPE int	Tcl_TryObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UnloadObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UnsetObjCmd(ClientData clientData,
................................................................................

typedef enum TclProcessWaitStatus {
    TCL_PROCESS_ERROR = -1,	/* Error waiting for process to exit */
    TCL_PROCESS_UNCHANGED = 0,	/* No change since the last call. */
    TCL_PROCESS_EXITED = 1,	/* Process has exited. */
    TCL_PROCESS_SIGNALED = 2,	/* Child killed because of a signal. */
    TCL_PROCESS_STOPPED = 3,	/* Child suspended because of a signal. */
    TCL_PROCESS_UNKNOWN_STATUS = 4
				/* Child wait status didn't make sense. */
} TclProcessWaitStatus;

MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp);
MODULE_SCOPE void	TclProcessCreated(Tcl_Pid pid);
MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
			    int *codePtr, Tcl_Obj **msgObjPtr,

Changes to generic/tclTrace.c.

96
97
98
99
100
101
102












103
104
105
106
107
108
109
110
111
112
113
114
115
116
...
162
163
164
165
166
167
168

























































































































































































169
170
171
172
173
174
175
...
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
...
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
...
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
...
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
...
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
...
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
...
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
...
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
...
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
...
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
...
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
...
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
...
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
...
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
....
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
....
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
....
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
typedef int (Tcl_TraceTypeObjCmd)(Tcl_Interp *interp, int optionIndex,
	int objc, Tcl_Obj *const objv[]);

static Tcl_TraceTypeObjCmd TraceVariableObjCmd;
static Tcl_TraceTypeObjCmd TraceCommandObjCmd;
static Tcl_TraceTypeObjCmd TraceExecutionObjCmd;













/*
 * Each subcommand has a number of 'types' to which it can apply. Currently
 * 'execution', 'command' and 'variable' are the only types supported. These
 * three arrays MUST be kept in sync! In the future we may provide an API to
 * add to the list of supported trace types.
 */

static const char *const traceTypeOptions[] = {
    "execution", "command", "variable", NULL
};
static Tcl_TraceTypeObjCmd *const traceSubCmds[] = {
    TraceExecutionObjCmd,
    TraceCommandObjCmd,
    TraceVariableObjCmd
................................................................................
    (clientData) = NULL; \
    while ((clientData = Tcl_CommandTraceInfo(interp, name, 0, \
	    TraceCommandProc, clientData)) != NULL)
 
/*
 *----------------------------------------------------------------------
 *

























































































































































































 * Tcl_TraceObjCmd --
 *
 *	This function is invoked to process the "trace" Tcl command. See the
 *	user documentation for details on what it does.
 *
 *	Standard syntax as of Tcl 8.4 is:
 *	    trace {add|info|remove} {command|variable} name ops cmd
................................................................................
Tcl_TraceObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int optionIndex;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
    const char *name;
    const char *flagOps, *p;
#endif
    /* Main sub commands to 'trace' */
    static const char *const traceOptions[] = {
	"add", "info", "remove",
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	"variable", "vdelete", "vinfo",
#endif
	NULL
    };
    /* 'OLD' options are pre-Tcl-8.4 style */
    enum traceOptions {
	TRACE_ADD, TRACE_INFO, TRACE_REMOVE,
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	TRACE_OLD_VARIABLE, TRACE_OLD_VDELETE, TRACE_OLD_VINFO
#endif
    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	return TCL_ERROR;
    }

................................................................................
		0, &typeIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	return traceSubCmds[typeIndex](interp, optionIndex, objc, objv);
	break;
    }

#ifndef TCL_REMOVE_OBSOLETE_TRACES
    case TRACE_OLD_VARIABLE:
    case TRACE_OLD_VDELETE: {
	Tcl_Obj *copyObjv[6];
	Tcl_Obj *opsList;
	int code, numFlags;

	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
	    return TCL_ERROR;
	}

	opsList = Tcl_NewObj();
	Tcl_IncrRefCount(opsList);
	flagOps = TclGetStringFromObj(objv[3], &numFlags);
	if (numFlags == 0) {
	    Tcl_DecrRefCount(opsList);
	    goto badVarOps;
	}
	for (p = flagOps; *p != 0; p++) {
	    Tcl_Obj *opObj;

	    if (*p == 'r') {
		TclNewLiteralStringObj(opObj, "read");
	    } else if (*p == 'w') {
		TclNewLiteralStringObj(opObj, "write");
	    } else if (*p == 'u') {
		TclNewLiteralStringObj(opObj, "unset");
	    } else if (*p == 'a') {
		TclNewLiteralStringObj(opObj, "array");
	    } else {
		Tcl_DecrRefCount(opsList);
		goto badVarOps;
	    }
	    Tcl_ListObjAppendElement(NULL, opsList, opObj);
	}
	copyObjv[0] = NULL;
	memcpy(copyObjv+1, objv, objc*sizeof(Tcl_Obj *));
	copyObjv[4] = opsList;
	if (optionIndex == TRACE_OLD_VARIABLE) {
	    code = traceSubCmds[2](interp, TRACE_ADD, objc+1, copyObjv);
	} else {
	    code = traceSubCmds[2](interp, TRACE_REMOVE, objc+1, copyObjv);
	}
	Tcl_DecrRefCount(opsList);
	return code;
    }
    case TRACE_OLD_VINFO: {
	ClientData clientData;
	char ops[5];
	Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr;

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name");
	    return TCL_ERROR;
	}
	resultListPtr = Tcl_NewObj();
	name = Tcl_GetString(objv[2]);
	FOREACH_VAR_TRACE(interp, name, clientData) {
	    TraceVarInfo *tvarPtr = clientData;
	    char *q = ops;

	    pairObjPtr = Tcl_NewListObj(0, NULL);
	    if (tvarPtr->flags & TCL_TRACE_READS) {
		*q = 'r';
		q++;
	    }
	    if (tvarPtr->flags & TCL_TRACE_WRITES) {
		*q = 'w';
		q++;
	    }
	    if (tvarPtr->flags & TCL_TRACE_UNSETS) {
		*q = 'u';
		q++;
	    }
	    if (tvarPtr->flags & TCL_TRACE_ARRAY) {
		*q = 'a';
		q++;
	    }
	    *q = '\0';

	    /*
	     * Build a pair (2-item list) with the ops string as the first obj
	     * element and the tvarPtr->command string as the second obj
	     * element. Append the pair (as an element) to the end of the
	     * result object list.
	     */

	    elemObjPtr = Tcl_NewStringObj(ops, -1);
	    Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
	    elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
	    Tcl_ListObjAppendElement(NULL, pairObjPtr, elemObjPtr);
	    Tcl_ListObjAppendElement(interp, resultListPtr, pairObjPtr);
	}
	Tcl_SetObjResult(interp, resultListPtr);
	break;
    }
#endif /* TCL_REMOVE_OBSOLETE_TRACES */
    }
    return TCL_OK;

#ifndef TCL_REMOVE_OBSOLETE_TRACES
  badVarOps:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "bad operations \"%s\": should be one or more of rwua",
	    flagOps));
    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "BADOPS", NULL);
    return TCL_ERROR;
#endif
}
 
/*
 *----------------------------------------------------------------------
 *
 * TraceExecutionObjCmd --
 *
 *	Helper function for Tcl_TraceObjCmd; implements the [trace
................................................................................
    switch ((enum traceOptions) optionIndex) {
    case TRACE_ADD:
    case TRACE_REMOVE: {
	int flags = 0;
	int i, listLen, result;
	Tcl_Obj **elemPtrs;

	if (objc != 6) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
	    return TCL_ERROR;
	}

	/*
	 * Make sure the ops argument is a list object; get its length and a
	 * pointer to its array of element pointers.
	 */

	result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	if (listLen == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "bad operation list \"\": must be one or more of"
		    " enter, leave, enterstep, or leavestep", -1));
................................................................................
		flags |= TCL_TRACE_ENTER_DURING_EXEC;
		break;
	    case TRACE_EXEC_LEAVE_STEP:
		flags |= TCL_TRACE_LEAVE_DURING_EXEC;
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = ckalloc(
		    TclOffset(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
................................................................................
	    tcmdPtr->refCount = 1;
	    flags |= TCL_TRACE_DELETE;
	    if (flags & (TCL_TRACE_ENTER_DURING_EXEC |
		    TCL_TRACE_LEAVE_DURING_EXEC)) {
		flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
	    }
	    memcpy(tcmdPtr->command, command, length+1);
	    name = Tcl_GetString(objv[3]);
	    if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
		    tcmdPtr) != TCL_OK) {
		ckfree(tcmdPtr);
		return TCL_ERROR;
	    }
	} else {
	    /*
................................................................................

	    ClientData clientData;

	    /*
	     * First ensure the name given is valid.
	     */

	    name = Tcl_GetString(objv[3]);
	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;
	    }

	    FOREACH_COMMAND_TRACE(interp, name, clientData) {
		TraceCommandInfo *tcmdPtr = clientData;

................................................................................
	}
	break;
    }
    case TRACE_INFO: {
	ClientData clientData;
	Tcl_Obj *resultListPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name");
	    return TCL_ERROR;
	}

	name = Tcl_GetString(objv[3]);

	/*
	 * First ensure the name given is valid.
	 */

	if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
	    return TCL_ERROR;
................................................................................
    switch ((enum traceOptions) optionIndex) {
    case TRACE_ADD:
    case TRACE_REMOVE: {
	int flags = 0;
	int i, listLen, result;
	Tcl_Obj **elemPtrs;

	if (objc != 6) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
	    return TCL_ERROR;
	}

	/*
	 * Make sure the ops argument is a list object; get its length and a
	 * pointer to its array of element pointers.
	 */
................................................................................
		break;
	    case TRACE_CMD_DELETE:
		flags |= TCL_TRACE_DELETE;
		break;
	    }
	}

	command = TclGetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = ckalloc(
		    TclOffset(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
	    tcmdPtr->startCmd = NULL;
	    tcmdPtr->length = length;
	    tcmdPtr->refCount = 1;
	    flags |= TCL_TRACE_DELETE;
	    memcpy(tcmdPtr->command, command, length+1);
	    name = Tcl_GetString(objv[3]);
	    if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
		    tcmdPtr) != TCL_OK) {
		ckfree(tcmdPtr);
		return TCL_ERROR;
	    }
	} else {
	    /*
................................................................................

	    ClientData clientData;

	    /*
	     * First ensure the name given is valid.
	     */

	    name = Tcl_GetString(objv[3]);
	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;
	    }

	    FOREACH_COMMAND_TRACE(interp, name, clientData) {
		TraceCommandInfo *tcmdPtr = clientData;

................................................................................
	}
	break;
    }
    case TRACE_INFO: {
	ClientData clientData;
	Tcl_Obj *resultListPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name");
	    return TCL_ERROR;
	}

	/*
	 * First ensure the name given is valid.
	 */

	name = Tcl_GetString(objv[3]);
	if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
	    return TCL_ERROR;
	}

	resultListPtr = Tcl_NewListObj(0, NULL);
	FOREACH_COMMAND_TRACE(interp, name, clientData) {
	    int numOps = 0;
................................................................................
    switch ((enum traceOptions) optionIndex) {
    case TRACE_ADD:
    case TRACE_REMOVE: {
	int flags = 0;
	int i, listLen, result;
	Tcl_Obj **elemPtrs;

	if (objc != 6) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name opList command");
	    return TCL_ERROR;
	}

	/*
	 * Make sure the ops argument is a list object; get its length and a
	 * pointer to its array of element pointers.
	 */

	result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	if (listLen == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "bad operation list \"\": must be one or more of"
		    " array, read, unset, or write", -1));
................................................................................
		flags |= TCL_TRACE_UNSETS;
		break;
	    case TRACE_VAR_WRITE:
		flags |= TCL_TRACE_WRITES;
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    CombinedTraceVarInfo *ctvarPtr = ckalloc(
		    TclOffset(CombinedTraceVarInfo, traceCmdInfo.command)
		    + 1 + length);

	    ctvarPtr->traceCmdInfo.flags = flags;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	    if (objv[0] == NULL) {
		ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE;
	    }
#endif
	    ctvarPtr->traceCmdInfo.length = length;
	    flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
	    memcpy(ctvarPtr->traceCmdInfo.command, command, length+1);
	    ctvarPtr->traceInfo.traceProc = TraceVarProc;
	    ctvarPtr->traceInfo.clientData = &ctvarPtr->traceCmdInfo;
	    ctvarPtr->traceInfo.flags = flags;
	    name = Tcl_GetString(objv[3]);
	    if (TraceVarEx(interp, name, NULL, (VarTrace *) ctvarPtr)
		    != TCL_OK) {
		ckfree(ctvarPtr);
		return TCL_ERROR;
	    }
	} else {
	    /*
	     * Search through all of our traces on this variable to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.
	     */

	    name = Tcl_GetString(objv[3]);
	    FOREACH_VAR_TRACE(interp, name, clientData) {
		TraceVarInfo *tvarPtr = clientData;

		if ((tvarPtr->length == length)
			&& ((tvarPtr->flags
#ifndef TCL_REMOVE_OBSOLETE_TRACES
& ~TCL_TRACE_OLD_STYLE
#endif
						)==flags)
			&& (strncmp(command, tvarPtr->command,
				(size_t) length) == 0)) {
		    Tcl_UntraceVar2(interp, name, NULL,
			    flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT,
			    TraceVarProc, clientData);
		    break;
................................................................................
	    }
	}
	break;
    }
    case TRACE_INFO: {
	Tcl_Obj *resultListPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name");
	    return TCL_ERROR;
	}

	resultListPtr = Tcl_NewObj();
	name = Tcl_GetString(objv[3]);
	FOREACH_VAR_TRACE(interp, name, clientData) {
	    Tcl_Obj *opObjPtr, *eachTraceObjPtr, *elemObjPtr;
	    TraceVarInfo *tvarPtr = clientData;

	    /*
	     * Build a list with the ops list as the first obj element and the
	     * tcmdPtr->command string as the second obj element. Append this
................................................................................
	     * the two variable names and the operation.
	     */

	    Tcl_DStringInit(&cmd);
	    Tcl_DStringAppend(&cmd, tvarPtr->command, (int) tvarPtr->length);
	    Tcl_DStringAppendElement(&cmd, name1);
	    Tcl_DStringAppendElement(&cmd, (name2 ? name2 : ""));
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	    if (tvarPtr->flags & TCL_TRACE_OLD_STYLE) {
		if (flags & TCL_TRACE_ARRAY) {
		    TclDStringAppendLiteral(&cmd, " a");
		} else if (flags & TCL_TRACE_READS) {
		    TclDStringAppendLiteral(&cmd, " r");
		} else if (flags & TCL_TRACE_WRITES) {
		    TclDStringAppendLiteral(&cmd, " w");
		} else if (flags & TCL_TRACE_UNSETS) {
		    TclDStringAppendLiteral(&cmd, " u");
		}
	    } else {
#endif
		if (flags & TCL_TRACE_ARRAY) {
		    TclDStringAppendLiteral(&cmd, " array");
		} else if (flags & TCL_TRACE_READS) {
		    TclDStringAppendLiteral(&cmd, " read");
		} else if (flags & TCL_TRACE_WRITES) {
		    TclDStringAppendLiteral(&cmd, " write");
		} else if (flags & TCL_TRACE_UNSETS) {
		    TclDStringAppendLiteral(&cmd, " unset");
		}
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	    }
#endif

	    /*
	     * 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
................................................................................
    /*
     * Set up a mask to mask out the parts of the flags that we are not
     * interested in now.
     */

    flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
	  TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
    flagMask |= TCL_TRACE_OLD_STYLE;
#endif
    flags &= flagMask;

    hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
    for (tracePtr = Tcl_GetHashValue(hPtr), prevPtr = NULL; ;
	    prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
	if (tracePtr == NULL) {
	    goto updateFlags;
................................................................................

    /*
     * Set up trace information.
     */

    flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
	  TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
    flagMask |= TCL_TRACE_OLD_STYLE;
#endif
    tracePtr->flags = tracePtr->flags & flagMask;

    hPtr = Tcl_CreateHashEntry(&iPtr->varTraces, varPtr, &isNew);
    if (isNew) {
	tracePtr->nextPtr = NULL;
    } else {
	tracePtr->nextPtr = Tcl_GetHashValue(hPtr);






>
>
>
>
>
>
>
>
>
>
>
>






<







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







<
<
<
<



<
<
<





<
<
<







 







<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

|
<
<
<
<
<
<
<

<







 







|
|








|







 







|







 







|







 







|







 







|
|



|







 







|
|







 







|













|







 







|







 







|
|







|







 







|
|








|







 







|







<
<
<
<
<






|












|





<
<
<







 







|
|




|







 







<
<
<
<
<
<
<
<
<
<
<
<
<









<
<
<







 







<
<
<







 







<
<
<







96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120

121
122
123
124
125
126
127
...
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
...
383
384
385
386
387
388
389




390
391
392



393
394
395
396
397



398
399
400
401
402
403
404
...
448
449
450
451
452
453
454






455




























































































456
457







458

459
460
461
462
463
464
465
...
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
...
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
...
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
...
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
...
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
...
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
...
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
...
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
...
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
...
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
...
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998





999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023



1024
1025
1026
1027
1028
1029
1030
....
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
....
2077
2078
2079
2080
2081
2082
2083













2084
2085
2086
2087
2088
2089
2090
2091
2092



2093
2094
2095
2096
2097
2098
2099
....
2998
2999
3000
3001
3002
3003
3004



3005
3006
3007
3008
3009
3010
3011
....
3346
3347
3348
3349
3350
3351
3352



3353
3354
3355
3356
3357
3358
3359
typedef int (Tcl_TraceTypeObjCmd)(Tcl_Interp *interp, int optionIndex,
	int objc, Tcl_Obj *const objv[]);

static Tcl_TraceTypeObjCmd TraceVariableObjCmd;
static Tcl_TraceTypeObjCmd TraceCommandObjCmd;
static Tcl_TraceTypeObjCmd TraceExecutionObjCmd;

static int TraceAddObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int TraceRemoveObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int TraceInfoObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);

/*
 * Each primary subcommand has its own command procedure and its own index.
 * The index is used to select the correct action.
 */
enum traceOptions {
	TRACE_ADD, TRACE_INFO, TRACE_REMOVE
};

/*
 * Each subcommand has a number of 'types' to which it can apply. Currently
 * 'execution', 'command' and 'variable' are the only types supported. These
 * three arrays MUST be kept in sync! In the future we may provide an API to
 * add to the list of supported trace types.
 */

static const char *const traceTypeOptions[] = {
    "execution", "command", "variable", NULL
};
static Tcl_TraceTypeObjCmd *const traceSubCmds[] = {
    TraceExecutionObjCmd,
    TraceCommandObjCmd,
    TraceVariableObjCmd
................................................................................
    (clientData) = NULL; \
    while ((clientData = Tcl_CommandTraceInfo(interp, name, 0, \
	    TraceCommandProc, clientData)) != NULL)
 
/*
 *----------------------------------------------------------------------
 *
 * TclTraceInit --
 *
 *      Registers the 'trace' subcommands with the Tcl interpreter
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Installs the commands (there are no client data)
 *
 * Note:
 *      Copied directly from the clock command's initialisation routine
 *----------------------------------------------------------------------
 */

void
TclTraceInit(
    Tcl_Interp *interp)         /* Tcl interpreter */
{
    char cmdName[50];           /* Buffer large enough to hold the string
                                 *::tcl::trace::remove
                                 * plus a terminating NUL. */
    EnsembleImplMap *traceCmdPtr;

    /* Structure of the 'trace' ensemble */

    static EnsembleImplMap traceImplMap[] = {
        {"add",          TraceAddObjCmd,          NULL, NULL, NULL,       0},
        {"remove",       TraceRemoveObjCmd,       NULL, NULL, NULL,       0},
        {"info",         TraceInfoObjCmd,         NULL, NULL, NULL,       0},
        {NULL,           NULL,                    NULL, NULL, NULL,       0}
    };

    /*
     * Install the commands.
     * TODO - Let Tcl_MakeEnsemble do this?
     */

#define TCL_TRACE_PREFIX_LEN 14 /* == strlen("::tcl::clock::") */
    memcpy(cmdName, "::tcl::trace::", TCL_TRACE_PREFIX_LEN);
    for (traceCmdPtr=traceImplMap ; traceCmdPtr->name!=NULL ; traceCmdPtr++) {
        strcpy(cmdName + TCL_TRACE_PREFIX_LEN, traceCmdPtr->name);
        Tcl_CreateObjCommand(interp, cmdName, traceCmdPtr->proc, NULL,
                NULL);
    }

    /* Make the trace ensemble */

    TclMakeEnsemble(interp, "trace", traceImplMap);
}
 


/*
 *----------------------------------------------------------------------
 *
 * TraceAddObjCmd --
 *
 *	This function is invoked to process the "trace add" Tcl command. See the
 *	user documentation for details on what it does.
 *
 *	Standard syntax as of Tcl 8.4 is:
 *	    trace add {execution|command|variable} name ops cmd
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TraceAddObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int typeIndex;

    if (objc != 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "name opList cmdPrefix");
	return TCL_ERROR;
    }

	if (Tcl_GetIndexFromObj(interp, objv[1], traceTypeOptions, "option",
		0, &typeIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	return traceSubCmds[typeIndex](interp, TRACE_ADD, objc, objv);
}
 


/*
 *----------------------------------------------------------------------
 *
 * TraceRemoveObjCmd --
 *
 *	This function is invoked to process the "trace remove" Tcl command. See the
 *	user documentation for details on what it does.
 *
 *	Standard syntax as of Tcl 8.4 is:
 *	    trace remove {execution|command|variable} name ops cmd
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TraceRemoveObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int typeIndex;

    if (objc != 5) {
	Tcl_WrongNumArgs(interp, 2, objv, "name opList cmdPrefix");
	return TCL_ERROR;
    }

	if (Tcl_GetIndexFromObj(interp, objv[1], traceTypeOptions, "option",
		0, &typeIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	return traceSubCmds[typeIndex](interp, TRACE_REMOVE, objc, objv);
}
 


/*
 *----------------------------------------------------------------------
 *
 * TraceInfoObjCmd --
 *
 *	This function is invoked to process the "trace info" Tcl command. See the
 *	user documentation for details on what it does.
 *
 *	Standard syntax as of Tcl 8.4 is:
 *	    trace remove {execution|command|variable} name
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TraceInfoObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int typeIndex;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }

	if (Tcl_GetIndexFromObj(interp, objv[1], traceTypeOptions, "option",
		0, &typeIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	return traceSubCmds[typeIndex](interp, TRACE_INFO, objc, objv);
}
 

#ifndef TCL_ORIGINAL_TRACE
/*
 *----------------------------------------------------------------------
 *
 * Tcl_TraceObjCmd --
 *
 *	This function is invoked to process the "trace" Tcl command. See the
 *	user documentation for details on what it does.
 *
 *	Standard syntax as of Tcl 8.4 is:
 *	    trace {add|info|remove} {command|variable} name ops cmd
................................................................................
Tcl_TraceObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int optionIndex;




    /* Main sub commands to 'trace' */
    static const char *const traceOptions[] = {
	"add", "info", "remove",



	NULL
    };
    /* 'OLD' options are pre-Tcl-8.4 style */
    enum traceOptions {
	TRACE_ADD, TRACE_INFO, TRACE_REMOVE,



    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	return TCL_ERROR;
    }

................................................................................
		0, &typeIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	return traceSubCmds[typeIndex](interp, optionIndex, objc, objv);
	break;
    }







    }




























































































    return TCL_OK;
}







#endif

 
/*
 *----------------------------------------------------------------------
 *
 * TraceExecutionObjCmd --
 *
 *	Helper function for Tcl_TraceObjCmd; implements the [trace
................................................................................
    switch ((enum traceOptions) optionIndex) {
    case TRACE_ADD:
    case TRACE_REMOVE: {
	int flags = 0;
	int i, listLen, result;
	Tcl_Obj **elemPtrs;

	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name opList command");
	    return TCL_ERROR;
	}

	/*
	 * Make sure the ops argument is a list object; get its length and a
	 * pointer to its array of element pointers.
	 */

	result = Tcl_ListObjGetElements(interp, objv[3], &listLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	if (listLen == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "bad operation list \"\": must be one or more of"
		    " enter, leave, enterstep, or leavestep", -1));
................................................................................
		flags |= TCL_TRACE_ENTER_DURING_EXEC;
		break;
	    case TRACE_EXEC_LEAVE_STEP:
		flags |= TCL_TRACE_LEAVE_DURING_EXEC;
		break;
	    }
	}
	command = TclGetStringFromObj(objv[4], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = ckalloc(
		    TclOffset(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
................................................................................
	    tcmdPtr->refCount = 1;
	    flags |= TCL_TRACE_DELETE;
	    if (flags & (TCL_TRACE_ENTER_DURING_EXEC |
		    TCL_TRACE_LEAVE_DURING_EXEC)) {
		flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
	    }
	    memcpy(tcmdPtr->command, command, length+1);
	    name = Tcl_GetString(objv[2]);
	    if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
		    tcmdPtr) != TCL_OK) {
		ckfree(tcmdPtr);
		return TCL_ERROR;
	    }
	} else {
	    /*
................................................................................

	    ClientData clientData;

	    /*
	     * First ensure the name given is valid.
	     */

	    name = Tcl_GetString(objv[2]);
	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;
	    }

	    FOREACH_COMMAND_TRACE(interp, name, clientData) {
		TraceCommandInfo *tcmdPtr = clientData;

................................................................................
	}
	break;
    }
    case TRACE_INFO: {
	ClientData clientData;
	Tcl_Obj *resultListPtr;

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name");
	    return TCL_ERROR;
	}

	name = Tcl_GetString(objv[2]);

	/*
	 * First ensure the name given is valid.
	 */

	if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
	    return TCL_ERROR;
................................................................................
    switch ((enum traceOptions) optionIndex) {
    case TRACE_ADD:
    case TRACE_REMOVE: {
	int flags = 0;
	int i, listLen, result;
	Tcl_Obj **elemPtrs;

	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name opList command");
	    return TCL_ERROR;
	}

	/*
	 * Make sure the ops argument is a list object; get its length and a
	 * pointer to its array of element pointers.
	 */
................................................................................
		break;
	    case TRACE_CMD_DELETE:
		flags |= TCL_TRACE_DELETE;
		break;
	    }
	}

	command = TclGetStringFromObj(objv[4], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = ckalloc(
		    TclOffset(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
	    tcmdPtr->startCmd = NULL;
	    tcmdPtr->length = length;
	    tcmdPtr->refCount = 1;
	    flags |= TCL_TRACE_DELETE;
	    memcpy(tcmdPtr->command, command, length+1);
	    name = Tcl_GetString(objv[2]);
	    if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
		    tcmdPtr) != TCL_OK) {
		ckfree(tcmdPtr);
		return TCL_ERROR;
	    }
	} else {
	    /*
................................................................................

	    ClientData clientData;

	    /*
	     * First ensure the name given is valid.
	     */

	    name = Tcl_GetString(objv[2]);
	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;
	    }

	    FOREACH_COMMAND_TRACE(interp, name, clientData) {
		TraceCommandInfo *tcmdPtr = clientData;

................................................................................
	}
	break;
    }
    case TRACE_INFO: {
	ClientData clientData;
	Tcl_Obj *resultListPtr;

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name");
	    return TCL_ERROR;
	}

	/*
	 * First ensure the name given is valid.
	 */

	name = Tcl_GetString(objv[2]);
	if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
	    return TCL_ERROR;
	}

	resultListPtr = Tcl_NewListObj(0, NULL);
	FOREACH_COMMAND_TRACE(interp, name, clientData) {
	    int numOps = 0;
................................................................................
    switch ((enum traceOptions) optionIndex) {
    case TRACE_ADD:
    case TRACE_REMOVE: {
	int flags = 0;
	int i, listLen, result;
	Tcl_Obj **elemPtrs;

	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name opList command");
	    return TCL_ERROR;
	}

	/*
	 * Make sure the ops argument is a list object; get its length and a
	 * pointer to its array of element pointers.
	 */

	result = Tcl_ListObjGetElements(interp, objv[3], &listLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	if (listLen == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "bad operation list \"\": must be one or more of"
		    " array, read, unset, or write", -1));
................................................................................
		flags |= TCL_TRACE_UNSETS;
		break;
	    case TRACE_VAR_WRITE:
		flags |= TCL_TRACE_WRITES;
		break;
	    }
	}
	command = TclGetStringFromObj(objv[4], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    CombinedTraceVarInfo *ctvarPtr = ckalloc(
		    TclOffset(CombinedTraceVarInfo, traceCmdInfo.command)
		    + 1 + length);

	    ctvarPtr->traceCmdInfo.flags = flags;





	    ctvarPtr->traceCmdInfo.length = length;
	    flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
	    memcpy(ctvarPtr->traceCmdInfo.command, command, length+1);
	    ctvarPtr->traceInfo.traceProc = TraceVarProc;
	    ctvarPtr->traceInfo.clientData = &ctvarPtr->traceCmdInfo;
	    ctvarPtr->traceInfo.flags = flags;
	    name = Tcl_GetString(objv[2]);
	    if (TraceVarEx(interp, name, NULL, (VarTrace *) ctvarPtr)
		    != TCL_OK) {
		ckfree(ctvarPtr);
		return TCL_ERROR;
	    }
	} else {
	    /*
	     * Search through all of our traces on this variable to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.
	     */

	    name = Tcl_GetString(objv[2]);
	    FOREACH_VAR_TRACE(interp, name, clientData) {
		TraceVarInfo *tvarPtr = clientData;

		if ((tvarPtr->length == length)
			&& ((tvarPtr->flags



						)==flags)
			&& (strncmp(command, tvarPtr->command,
				(size_t) length) == 0)) {
		    Tcl_UntraceVar2(interp, name, NULL,
			    flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT,
			    TraceVarProc, clientData);
		    break;
................................................................................
	    }
	}
	break;
    }
    case TRACE_INFO: {
	Tcl_Obj *resultListPtr;

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name");
	    return TCL_ERROR;
	}

	resultListPtr = Tcl_NewObj();
	name = Tcl_GetString(objv[2]);
	FOREACH_VAR_TRACE(interp, name, clientData) {
	    Tcl_Obj *opObjPtr, *eachTraceObjPtr, *elemObjPtr;
	    TraceVarInfo *tvarPtr = clientData;

	    /*
	     * Build a list with the ops list as the first obj element and the
	     * tcmdPtr->command string as the second obj element. Append this
................................................................................
	     * the two variable names and the operation.
	     */

	    Tcl_DStringInit(&cmd);
	    Tcl_DStringAppend(&cmd, tvarPtr->command, (int) tvarPtr->length);
	    Tcl_DStringAppendElement(&cmd, name1);
	    Tcl_DStringAppendElement(&cmd, (name2 ? name2 : ""));













		if (flags & TCL_TRACE_ARRAY) {
		    TclDStringAppendLiteral(&cmd, " array");
		} else if (flags & TCL_TRACE_READS) {
		    TclDStringAppendLiteral(&cmd, " read");
		} else if (flags & TCL_TRACE_WRITES) {
		    TclDStringAppendLiteral(&cmd, " write");
		} else if (flags & TCL_TRACE_UNSETS) {
		    TclDStringAppendLiteral(&cmd, " unset");
		}




	    /*
	     * 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
................................................................................
    /*
     * Set up a mask to mask out the parts of the flags that we are not
     * interested in now.
     */

    flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
	  TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;



    flags &= flagMask;

    hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
    for (tracePtr = Tcl_GetHashValue(hPtr), prevPtr = NULL; ;
	    prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
	if (tracePtr == NULL) {
	    goto updateFlags;
................................................................................

    /*
     * Set up trace information.
     */

    flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
	  TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;



    tracePtr->flags = tracePtr->flags & flagMask;

    hPtr = Tcl_CreateHashEntry(&iPtr->varTraces, varPtr, &isNew);
    if (isNew) {
	tracePtr->nextPtr = NULL;
    } else {
	tracePtr->nextPtr = Tcl_GetHashValue(hPtr);