Check-in [c6070d8891]
Not logged in
Home Downloads Timeline Branches Tags Tickets Wiki Login

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

Overview
Comment:further improvements of tclx's profile command
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: c6070d8891e3d4a01e7dd389bdd255c23b0e1342
User & Date: chw 2016-11-25 13:50:09.929
Context
2016-11-27
18:55
add tk upstream changes check-in: c607156404 user: chw tags: trunk
2016-11-25
13:50
further improvements of tclx's profile command check-in: c6070d8891 user: chw tags: trunk
2016-11-21
19:27
simplification of check-in [c29648d90f] check-in: eec9d69bc1 user: chw tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to jni/tclx/generic/tclXprofile.c.
︙︙
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

 *-----------------------------------------------------------------------------
 * $Id: tclXprofile.c,v 1.4 2009/10/13 19:28:23 kot Exp $
 *-----------------------------------------------------------------------------
 */

#include "tclExtdInt.h"

/*
 * On Tcl 8.6 and newer, use Tcl_CreateObjTrace() etc.
 */
#if TCL_MAJOR_VERSION > 8 || \
   (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 6)
#define OBJ_AND_NRE 1
#endif

/*
 * For when the level is not known.
 */
#define UNKNOWN_LEVEL -1

/*
 * Stack entry used to keep track of an profiling information for procedures








<
<
<
<
<
<
<
<








14
15
16
17
18
19
20








21
22
23
24
25
26
27

 *-----------------------------------------------------------------------------
 * $Id: tclXprofile.c,v 1.4 2009/10/13 19:28:23 kot Exp $
 *-----------------------------------------------------------------------------
 */

#include "tclExtdInt.h"









/*
 * For when the level is not known.
 */
#define UNKNOWN_LEVEL -1

/*
 * Stack entry used to keep track of an profiling information for procedures
︙︙
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92

 */

typedef struct profInfo_t { 
    Tcl_Interp     *interp;                /* Interpreter this is for.       */
    Tcl_Trace       traceHandle;           /* Handle to current trace.       */
    int             commandMode;           /* Prof all commands?             */
    int             evalMode;              /* Use eval stack.                */
    Command        *currentCmdPtr;         /* Current command table entry.   */
    Tcl_CmdProc    *savedStrCmdProc;       /* Saved string command function  */
    ClientData      savedStrCmdClientData; /* and clientData.                */
    Tcl_ObjCmdProc *savedObjCmdProc;       /* Saved object command function  */
#ifdef OBJ_AND_NRE
    Tcl_ObjCmdProc *savedNreProc;          /* and NRE function               */
#endif
    ClientData      savedObjCmdClientData; /* and clientData.                */
    int             evalLevel;             /* Eval level when invoked.       */
    clock_t         realTime;              /* Current real and CPU time.     */
    clock_t         cpuTime;
    clock_t         prevRealTime;          /* Real and CPU time of previous  */
    clock_t         prevCpuTime;           /* trace.                         */
    int             updatedTimes;          /* Has current times been updated?*/
    profEntry_t    *stackPtr;              /* Proc/command nesting stack.    */








|
<
|
<
<
|
<
<








63
64
65
66
67
68
69
70

71


72


73
74
75
76
77
78
79

 */

typedef struct profInfo_t { 
    Tcl_Interp     *interp;                /* Interpreter this is for.       */
    Tcl_Trace       traceHandle;           /* Handle to current trace.       */
    int             commandMode;           /* Prof all commands?             */
    int             evalMode;              /* Use eval stack.                */
    Tcl_Command     profileCmd;            /* "profile" Tcl command.         */

    Tcl_Command     profExecCmd;           /* "profexec" Tcl command.        */


    Tcl_Command     currentCmd;            /* Current execution traced cmd.  */


    int             evalLevel;             /* Eval level when invoked.       */
    clock_t         realTime;              /* Current real and CPU time.     */
    clock_t         cpuTime;
    clock_t         prevRealTime;          /* Real and CPU time of previous  */
    clock_t         prevCpuTime;           /* trace.                         */
    int             updatedTimes;          /* Has current times been updated?*/
    profEntry_t    *stackPtr;              /* Proc/command nesting stack.    */
︙︙
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177


static void
PopEntry _ANSI_ARGS_((profInfo_t *infoPtr));

static void
UpdateTOSTimes _ANSI_ARGS_((profInfo_t *infoPtr));

static Command *
ProfCommandEvalSetup _ANSI_ARGS_((profInfo_t *infoPtr,
                                  int        *isProcPtr));
    
static void
ProfCommandEvalFinishup _ANSI_ARGS_((profInfo_t *infoPtr,
                                     int         isProc));

static int
ProfStrCommandEval _ANSI_ARGS_((ClientData    clientData,
                                Tcl_Interp   *interp,
                                int           argc,
                                CONST84 char **argv));

static int
ProfObjCommandEval _ANSI_ARGS_((ClientData    clientData,
                                Tcl_Interp   *interp,
                                int           objc,
                                Tcl_Obj      *CONST objv[]));

#ifdef OBJ_AND_NRE
static int
ProfNreCommandEval _ANSI_ARGS_((ClientData    clientData,
                                Tcl_Interp   *interp,
                                int           objc,
                                Tcl_Obj      *CONST objv[]));

static int
ProfObjTraceRoutine _ANSI_ARGS_((ClientData     clientData,
                                 Tcl_Interp    *interp,
                                 int            evalLevel,
                                 const char    *command,
                                 Tcl_Command    cmd,
                                 int            objc,
                                 Tcl_Obj *const objv[]));
#else
static void
ProfTraceRoutine _ANSI_ARGS_((ClientData    clientData,
                              Tcl_Interp   *interp,
                              int           evalLevel,
                              char         *command,
                              Tcl_CmdProc  *cmdProc,
                              ClientData    cmdClientData,
                              int           argc,
                              char        **argv));
#endif
static void
CleanDataTable _ANSI_ARGS_((profInfo_t *infoPtr));

static void
InitializeProcStack _ANSI_ARGS_((profInfo_t *infoPtr,
                                 CallFrame  *framePtr));









<
<
<
<
<
<
<
<

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








105
106
107
108
109
110
111








112



















113
114
115
116
117
118
119
120










121
122
123
124
125
126
127


static void
PopEntry _ANSI_ARGS_((profInfo_t *infoPtr));

static void
UpdateTOSTimes _ANSI_ARGS_((profInfo_t *infoPtr));









static int



















ProfObjTraceRoutine _ANSI_ARGS_((ClientData      clientData,
                                 Tcl_Interp     *interp,
                                 int             evalLevel,
                                 const char     *command,
                                 Tcl_Command     cmd,
                                 int             objc,
                                 Tcl_Obj *const  objv[]));











static void
CleanDataTable _ANSI_ARGS_((profInfo_t *infoPtr));

static void
InitializeProcStack _ANSI_ARGS_((profInfo_t *infoPtr,
                                 CallFrame  *framePtr));
︙︙
410
411
412
413
414
415
416
417
418
419
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
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
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
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661

662
663
664

665
666
667
668
669
670
671

672
673
674
675
676
677
678



679
680
681
682

683

684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
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



730




731

732
733

734

735





736





737
738
739
740
741




742




743






744



745



746




747

748





749


750



751








752





753



754
755
756



757
758
759
760
761
762
763

            infoPtr->realTime - infoPtr->prevRealTime;
        infoPtr->scopeChainPtr->scopeCpuTime +=
            infoPtr->cpuTime - infoPtr->prevCpuTime;
    }
}

/*-----------------------------------------------------------------------------
 * ProfCommandEvalSetup --
 *   Do initial work that is common to both the string and object command
 * evaluators.
 *
 * Returns:
 *   A pointer to the current command table entry.
 *-----------------------------------------------------------------------------
 */
static Command *
ProfCommandEvalSetup (infoPtr, isProcPtr)
    profInfo_t *infoPtr;
    int        *isProcPtr;
{
    Interp *iPtr = (Interp *) infoPtr->interp;
    Command *currentCmdPtr;
    CallFrame *framePtr;
    int procLevel, scopeLevel, isProc;
    Tcl_Obj *fullCmdNamePtr;
    char *fullCmdName;

    /*
     * Restore the command table entry.  If the command has modified it, don't
     * mess with it.
     */
    currentCmdPtr = infoPtr->currentCmdPtr;
    if (currentCmdPtr->proc == ProfStrCommandEval)
        currentCmdPtr->proc = infoPtr->savedStrCmdProc;
    if (currentCmdPtr->clientData == (ClientData) infoPtr)
        currentCmdPtr->clientData = infoPtr->savedStrCmdClientData;
    if (currentCmdPtr->objProc == ProfObjCommandEval)
        currentCmdPtr->objProc = infoPtr->savedObjCmdProc;
#ifdef OBJ_AND_NRE
    if (currentCmdPtr->nreProc == ProfNreCommandEval)
        currentCmdPtr->nreProc = infoPtr->savedNreProc;
#endif
    if (currentCmdPtr->objClientData == (ClientData) infoPtr)
        currentCmdPtr->objClientData = infoPtr->savedObjCmdClientData;
    infoPtr->currentCmdPtr = NULL;
    infoPtr->savedStrCmdProc = NULL;
    infoPtr->savedStrCmdClientData = NULL;
    infoPtr->savedObjCmdProc = NULL;
#ifdef OBJ_AND_NRE
    infoPtr->savedNreProc = NULL;
#endif
    infoPtr->savedObjCmdClientData = NULL;

    fullCmdNamePtr = Tcl_NewObj ();
    Tcl_GetCommandFullName (infoPtr->interp, (Tcl_Command) currentCmdPtr, 
                            fullCmdNamePtr);
    fullCmdName = Tcl_GetStringFromObj (fullCmdNamePtr, NULL);

    /*
     * Determine current proc and var levels.
     */
    procLevel = 0;
    for (framePtr = iPtr->framePtr; framePtr != NULL; framePtr =
             framePtr->callerPtr) {
        procLevel++;
    }
    scopeLevel = (iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level;

    /* 
     * If there are entries on the stack that are at a higher proc call level
     * than we are, we have exited into the initial entries that where pushed
     * on the stack before we started.  Pop those entries.
     */
    if (infoPtr->stackPtr->procLevel > procLevel)
        UpdateTOSTimes (infoPtr);
    while (infoPtr->stackPtr->procLevel > procLevel) {
        if (infoPtr->stackPtr->evalLevel != UNKNOWN_LEVEL) 
            panic (PROF_PANIC, 2);  /* Not an initial entry */
        PopEntry (infoPtr);
    }

    /*
     * If this command is a procedure or if all commands are being traced,
     * handle the entry.
     */
    isProc = (TclFindProc (iPtr, fullCmdName) != NULL);
    if (infoPtr->commandMode || isProc) {
        UpdateTOSTimes (infoPtr);
        if (isProc) {
            PushEntry (infoPtr, fullCmdName, TRUE,
                       procLevel + 1, scopeLevel + 1, infoPtr->evalLevel);
        } else if (infoPtr->commandMode) {
            PushEntry (infoPtr, fullCmdName, FALSE,
                       procLevel, scopeLevel, infoPtr->evalLevel);
        }
    }

    /*
     * Leaving profiler, must get time again when we reenter.
     */
    infoPtr->updatedTimes = FALSE;

    *isProcPtr = isProc;

    Tcl_DecrRefCount (fullCmdNamePtr);
    return currentCmdPtr;
}

/*-----------------------------------------------------------------------------
 * ProfCommandEvalFinishup --
 *   Do final work that is common to both the string and object command
 * evaluators.
 *-----------------------------------------------------------------------------
 */
static void
ProfCommandEvalFinishup (infoPtr, isProc)
    profInfo_t *infoPtr;
    int         isProc;
{
    /*
     * If tracing is still running, pop the entry, recording the information.
     */
    if (infoPtr->traceHandle != NULL) {
        if (infoPtr->commandMode || isProc) {
            UpdateTOSTimes (infoPtr);
            PopEntry (infoPtr);
        }
    }
    /*
     * Leaving profiler, must get time again when we reenter.
     */
    infoPtr->updatedTimes = FALSE;
}

/*-----------------------------------------------------------------------------
 * ProfStrCommandEval --
 *   Function to evaluate a string command.  The procedure trace routine
 * substitutes this function for the command executor function in the Tcl
 * command table.  We restore the command table, record data about the start
 * of the command and then actually execute the command.  When the command
 * returns, we record data about the time it took.
 *
 * FIX:  This all falls apart if another trace is executed between the
 * doctoring of the command entry and this function being called.
 *-----------------------------------------------------------------------------
 */
static int
ProfStrCommandEval (clientData, interp, argc, argv)
    ClientData    clientData;
    Tcl_Interp   *interp;
    int           argc;
    CONST84 char **argv;
{
    profInfo_t *infoPtr = (profInfo_t *) clientData;
    Command *currentCmdPtr;
    int isProc, result;

    currentCmdPtr = ProfCommandEvalSetup (infoPtr, &isProc);

    result = (*currentCmdPtr->proc) (currentCmdPtr->clientData, interp,
                                     argc, argv);

    ProfCommandEvalFinishup (infoPtr, isProc);
    return result;
}

/*-----------------------------------------------------------------------------
 * ProfObjCommandEval --
 *   Function to evaluate a object command.  The procedure trace routine
 * substitutes this function for the command executor function in the Tcl
 * command table.  We restore the command table, record data about the start
 * of the command and then actually execute the command.  When the command
 * returns, we record data about the time it took.
 *
 * FIX:  This all falls apart if another trace is executed between the
 * doctoring of the command entry and this function being called.
 *-----------------------------------------------------------------------------
 */
static int
ProfObjCommandEval (clientData, interp, objc, objv)
    ClientData    clientData;
    Tcl_Interp   *interp;
    int           objc;
    Tcl_Obj     *CONST objv[];
{
    profInfo_t *infoPtr = (profInfo_t *) clientData;
    Command *currentCmdPtr;
    int isProc, result;

    currentCmdPtr = ProfCommandEvalSetup (infoPtr,
                                          &isProc);

    result = (*currentCmdPtr->objProc) (currentCmdPtr->objClientData, interp,
                                        objc, objv);

    ProfCommandEvalFinishup (infoPtr, isProc);
    return result;
}

#ifdef OBJ_AND_NRE
/*-----------------------------------------------------------------------------
 * ProfNreCommandEval --
 *   Function to evaluate a NRE object command.  The procedure trace routine
 * substitutes this function for the command executor function in the Tcl
 * command table.  We restore the command table, record data about the start
 * of the command and then actually execute the command.  When the command
 * returns, we record data about the time it took.
 *
 * FIX:  This all falls apart if another trace is executed between the
 * doctoring of the command entry and this function being called.
 *-----------------------------------------------------------------------------
 */
static int
ProfNreCommandEval (clientData, interp, objc, objv)
    ClientData    clientData;
    Tcl_Interp   *interp;
    int           objc;
    Tcl_Obj     *CONST objv[];
{
    profInfo_t *infoPtr = (profInfo_t *) clientData;
    Command *currentCmdPtr;
    int isProc, result;

    currentCmdPtr = ProfCommandEvalSetup (infoPtr,
                                          &isProc);

    result = (*currentCmdPtr->nreProc) (currentCmdPtr->objClientData, interp,
                                        objc, objv);

    ProfCommandEvalFinishup (infoPtr, isProc);
    return result;
}

/*-----------------------------------------------------------------------------
  * ProfObjTraceRoutine --
 *   Routine called by Tcl_Eval to do profiling.  It intercepts the current
 * command being executed by temporarily editing the command table.
 *-----------------------------------------------------------------------------
 */
static int
ProfObjTraceRoutine (clientData, interp, evalLevel, command, cmd,
                     objc, objv)
    ClientData       clientData;
    Tcl_Interp      *interp;
    int              evalLevel;
    const char      *command;
    Tcl_Command      cmd;
    int              objc;
    Tcl_Obj *const   objv[];
{
    profInfo_t *infoPtr = (profInfo_t *) clientData;
    Command *cmdPtr;


    if (infoPtr->currentCmdPtr != NULL)
        panic (PROF_PANIC, 3);


    cmdPtr = (Command *) cmd;

    /*
     * If command is to be compiled, we can't profile it.
     */
    if (cmdPtr->compileProc != NULL)

        return TCL_OK;

    /*
     * Save current state information.
     */
    infoPtr->currentCmdPtr = cmdPtr;
    infoPtr->savedStrCmdProc = cmdPtr->proc;



    infoPtr->savedStrCmdClientData = cmdPtr->clientData;
    infoPtr->savedObjCmdProc = cmdPtr->objProc;
    infoPtr->savedNreProc = cmdPtr->nreProc;
    infoPtr->savedObjCmdClientData = cmdPtr->objClientData;

    infoPtr->evalLevel = evalLevel;


    /*
     * Force our routines to be called.
     */
    cmdPtr->proc = ProfStrCommandEval;
    cmdPtr->clientData = (ClientData) infoPtr;
    cmdPtr->objProc = ProfObjCommandEval;
    if (cmdPtr->nreProc != NULL) {
        cmdPtr->nreProc = ProfNreCommandEval;
    }
    cmdPtr->objClientData = (ClientData) infoPtr;
    return TCL_OK;
}
#else

/*-----------------------------------------------------------------------------
  * ProfTraceRoutine --
 *   Routine called by Tcl_Eval to do profiling.  It intercepts the current
 * command being executed by temporarily editing the command table.


 *-----------------------------------------------------------------------------
 */
static void
ProfTraceRoutine (clientData, interp, evalLevel, command, cmdProc,
                  cmdClientData, argc, argv)
    ClientData    clientData;
    Tcl_Interp   *interp;
    int           evalLevel;
    char         *command;
    Tcl_CmdProc  *cmdProc;
    ClientData    cmdClientData;
    int           argc;
    char        **argv;
{
    profInfo_t *infoPtr = (profInfo_t *) clientData;
    Command *cmdPtr;



    Tcl_Command cmd;






    if (infoPtr->currentCmdPtr != NULL)


        panic (PROF_PANIC, 3);










    cmd = Tcl_FindCommand (interp, argv [0], NULL, 0);
    if (cmd == NULL)
        panic (PROF_PANIC, 4);
    cmdPtr = (Command *) cmd;





















    if ((cmdPtr->proc != cmdProc) || (cmdPtr->clientData != cmdClientData))



        panic (PROF_PANIC, 5);






    /*
     * If command is to be compiled, we can't profile it.

     */

    if (cmdPtr->compileProc != NULL)





        return;






    /*
     * Save current state information.
     */
    infoPtr->currentCmdPtr = cmdPtr;




    infoPtr->savedStrCmdProc = cmdPtr->proc;




    infoPtr->savedStrCmdClientData = cmdPtr->clientData;






    infoPtr->savedObjCmdProc = cmdPtr->objProc;



    infoPtr->savedObjCmdClientData = cmdPtr->objClientData;



    infoPtr->evalLevel = evalLevel;






    /*





     * Force our routines to be called.


     */



    cmdPtr->proc = ProfStrCommandEval;








    cmdPtr->clientData = (ClientData) infoPtr;





    cmdPtr->objProc = ProfObjCommandEval;



    cmdPtr->objClientData = (ClientData) infoPtr;
}
#endif /* OBJ_AND_NRE */




/*-----------------------------------------------------------------------------
 * CleanDataTable --
 *    Clean up the hash data table, releasing all resources and setting it
 * to the empty state.
 *
 * Parameters:








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

|














|
>

|
<
>

|
|
<
|
<
|
>
|
|
<
<
<
|
|
>
>
>
|
|
|
|
>
|
>
|
<
<
<
<
<
<
<
<
|
<
<
<
<
<

|
|
|
>
>


|
|
<
|
|
|
<
<
<
<
|


|
>
>
>

>
>

>
>
>
|
>
>
|
>

>
>
>
>
>
>
>
>
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>
>
>
>
>
>
|
>
>
>
|
>
>
>
>
|
>
|
|
>
|
>
|
>
>
>
>
>
|
>
>
>
>
>

|
|
|
|
>
>
>
>
|
>
>
>
>
|
>
>
>
>
>
>
|
>
>
>
|
>
>
>
|
>
>
>
>
|
>
|
>
>
>
>
>
|
>
>
|
>
>
>
|
>
>
>
>
>
>
>
>
|
>
>
>
>
>
|
>
>
>
|
|
<
>
>
>








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
386
387

388
389
390
391

392

393
394
395
396



397
398
399
400
401
402
403
404
405
406
407
408
409








410





411
412
413
414
415
416
417
418
419
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
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
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
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574

575
576
577
578
579
580
581
582
583
584

            infoPtr->realTime - infoPtr->prevRealTime;
        infoPtr->scopeChainPtr->scopeCpuTime +=
            infoPtr->cpuTime - infoPtr->prevCpuTime;
    }
}

/*-----------------------------------------------------------------------------



































































































































































































































 * ProfObjTraceRoutine --
 *   Routine called by Tcl_Eval to do profiling.  It intercepts the current
 * command being executed by installing an execution trace.
 *-----------------------------------------------------------------------------
 */
static int
ProfObjTraceRoutine (clientData, interp, evalLevel, command, cmd,
                     objc, objv)
    ClientData       clientData;
    Tcl_Interp      *interp;
    int              evalLevel;
    const char      *command;
    Tcl_Command      cmd;
    int              objc;
    Tcl_Obj *const   objv[];
{
    profInfo_t *infoPtr = (profInfo_t *) clientData;
    Tcl_Obj *listPtr, *namePtr;
    int result;

    if (infoPtr->currentCmd != NULL)

        return TCL_OK;

    listPtr = Tcl_NewObj ();
    Tcl_ListObjAppendElement (NULL, listPtr,

            Tcl_NewStringObj ("::trace", -1));

    Tcl_ListObjAppendElement (NULL, listPtr,
            Tcl_NewStringObj ("add", -1));
    Tcl_ListObjAppendElement (NULL, listPtr,
            Tcl_NewStringObj ("execution", -1));



    namePtr = Tcl_NewObj ();
    Tcl_GetCommandFullName (infoPtr->interp, cmd, namePtr);
    Tcl_ListObjAppendElement (NULL, listPtr, namePtr);
    Tcl_ListObjAppendElement (NULL, listPtr,
            Tcl_NewStringObj ("enter leave enterstep leavestep", -1));
    namePtr = Tcl_NewObj ();
    Tcl_GetCommandFullName (infoPtr->interp, infoPtr->profExecCmd, namePtr);
    Tcl_ListObjAppendElement (NULL, listPtr, namePtr);
    result = Tcl_EvalObjEx (interp, listPtr, TCL_EVAL_GLOBAL);
    if (result == TCL_OK)
        infoPtr->currentCmd = cmd;
    return result;
}














/*-----------------------------------------------------------------------------
 * ProfExecObjCmd --
 *   Implements the TCL profexec command which is the callback for
 * execution traces. Signatures:
 *     profexec cmdstring op                  "enter" and "enterstep"
 *     profexec cmdstring code result op      "leave" and "leavestep"
 *-----------------------------------------------------------------------------
 */
static int
ProfExecObjCmd (clientData, interp, objc, objv)

    ClientData   clientData;
    Tcl_Interp  *interp;
    int          objc;




    Tcl_Obj     *CONST objv[];
{
    profInfo_t *infoPtr = (profInfo_t *) clientData;
    Interp *iPtr = (Interp *) interp;
    const char *opStr;
    int cmdObjc, procLevel, scopeLevel, isProc;
    Tcl_Obj **cmdObjv, *fullCmdNameObj;
    Tcl_Command cmd;
    char *cmdName, *fullCmdName;
    CallFrame *framePtr;

    if ((objc != 3) && (objc != 5))
        return TclX_WrongArgs (interp, objv [0],
                               "cmdstring op|code ?result op?");

    if (infoPtr->traceHandle == NULL || infoPtr->currentCmd == NULL)
        return TCL_OK;  /* Ignored when not active */

    if (objc == 3) {            /* enter/enterstep */

        opStr = Tcl_GetStringFromObj (objv[2], NULL);
        if ((strcmp ("enter", opStr) != 0) &&
            (strcmp ("enterstep", opStr) != 0))
            return TCL_OK;  /* Ignore unknown ops */

        Tcl_ListObjGetElements (NULL, objv[1], &cmdObjc, &cmdObjv);
        if (cmdObjc > 0) {
            cmdName = Tcl_GetStringFromObj (cmdObjv[0], NULL);
            cmd = Tcl_FindCommand (interp, cmdName, NULL, 0);
            if (cmd == NULL) 
                panic (PROF_PANIC, 1000);

            fullCmdNameObj = Tcl_NewObj ();
            Tcl_GetCommandFullName (interp, cmd, fullCmdNameObj);
            fullCmdName = Tcl_GetStringFromObj (fullCmdNameObj, NULL);

            /*
             * Determine current proc and var levels.
             */
            procLevel = 0;
            for (framePtr = iPtr->framePtr; framePtr != NULL;
                 framePtr = framePtr->callerPtr) {
                procLevel++;
            }
            scopeLevel = (iPtr->varFramePtr == NULL) ?
                         0 : iPtr->varFramePtr->level;

            /* 
             * If there are entries on the stack that are at a higher
             * proc call level than we are, we have exited into the
             * initial entries that where pushed on the stack before
             * we started.  Pop those entries.
             */
            if (infoPtr->stackPtr->procLevel > procLevel) {
                UpdateTOSTimes (infoPtr);
                do {
                    if (infoPtr->stackPtr->evalLevel != UNKNOWN_LEVEL) 
                        panic (PROF_PANIC, 2);  /* Not an initial entry */
                    if (infoPtr->stackPtr->prevEntryPtr == NULL)
                        break;  /* Keep first entry */
                    PopEntry (infoPtr);
                } while (infoPtr->stackPtr->procLevel > procLevel);
            }

            /*
             * If this command is a procedure or if all commands are
             * being traced, handle the entry.
             */
            isProc = (TclFindProc (iPtr, fullCmdName) != NULL);
            if (infoPtr->commandMode || isProc) {
                UpdateTOSTimes (infoPtr);
                if (isProc) {
                    PushEntry (infoPtr, fullCmdName, TRUE,
                               procLevel + 1, scopeLevel + 1,
                               infoPtr->evalLevel);
                } else {
                    PushEntry (infoPtr, fullCmdName, FALSE,
                               procLevel, scopeLevel,
                               infoPtr->evalLevel);
                }
            }

            /*
             * Leaving profiler, must get time again when we reenter.
             */
            infoPtr->updatedTimes = FALSE;
            Tcl_DecrRefCount (fullCmdNameObj);
        }
    } else {                    /* leave/leavestep */
        int done = 0;

        opStr = Tcl_GetStringFromObj (objv[4], NULL);
        done = (strcmp ("leave", opStr) == 0);
        if (!done && (strcmp ("leavestep", opStr) != 0))
            return TCL_OK;  /* Ignore unknown ops */

        Tcl_ListObjGetElements (NULL, objv[1], &cmdObjc, &cmdObjv);
        if (cmdObjc > 0) {
            cmdName = Tcl_GetStringFromObj (cmdObjv[0], NULL);
            cmd = Tcl_FindCommand (interp, cmdName, NULL, 0);
            if (cmd == NULL) 
                panic (PROF_PANIC, 1001);

            fullCmdNameObj = Tcl_NewObj ();
            Tcl_GetCommandFullName (interp, cmd, fullCmdNameObj);
            fullCmdName = Tcl_GetStringFromObj (fullCmdNameObj, NULL);

            /*
             * Pop the entry, recording the information.
             */
            if (infoPtr->commandMode ||
                (TclFindProc (iPtr, fullCmdName) != NULL)) {
                UpdateTOSTimes (infoPtr);
                if (infoPtr->stackPtr->prevEntryPtr != NULL)
                    PopEntry (infoPtr);
            }

            /*
             * Leaving profiler, must get time again when we reenter.
             */
            infoPtr->updatedTimes = FALSE;
            Tcl_DecrRefCount (fullCmdNameObj);
        }

        /*
         * If op was "leave", turn off the execution trace now.
         */
        if (done) {
            Tcl_Obj *listPtr, *namePtr;
            int result;

            listPtr = Tcl_NewObj ();
            Tcl_ListObjAppendElement (NULL, listPtr,
                                      Tcl_NewStringObj ("::trace", -1));
            Tcl_ListObjAppendElement (NULL, listPtr,
                                      Tcl_NewStringObj ("remove", -1));
            Tcl_ListObjAppendElement (NULL, listPtr,
                                      Tcl_NewStringObj ("execution", -1));
            namePtr = Tcl_NewObj ();
            Tcl_GetCommandFullName (infoPtr->interp, infoPtr->currentCmd,
                                    namePtr);
            Tcl_ListObjAppendElement (NULL, listPtr, namePtr);
            Tcl_ListObjAppendElement (NULL, listPtr,
                    Tcl_NewStringObj ("enter leave enterstep leavestep", -1));
            namePtr = Tcl_NewObj ();
            Tcl_GetCommandFullName (infoPtr->interp, infoPtr->profExecCmd,
                                    namePtr);
            Tcl_ListObjAppendElement (NULL, listPtr, namePtr);
            result = Tcl_EvalObjEx (interp, listPtr, TCL_EVAL_GLOBAL);
            infoPtr->currentCmd = NULL;
        }    

    }
    return TCL_OK;
}

/*-----------------------------------------------------------------------------
 * CleanDataTable --
 *    Clean up the hash data table, releasing all resources and setting it
 * to the empty state.
 *
 * Parameters:
︙︙
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811

InitializeProcStack (infoPtr, framePtr)
    profInfo_t *infoPtr;
    CallFrame  *framePtr;
{
    if (framePtr == NULL || framePtr->objv == NULL)
        return;
    InitializeProcStack (infoPtr, framePtr->callerPtr);
    
       
    PushEntry (infoPtr,
               Tcl_GetStringFromObj (framePtr->objv [0], NULL),
               TRUE,
               infoPtr->stackPtr->procLevel + 1,
               framePtr->level,
               UNKNOWN_LEVEL);








<








618
619
620
621
622
623
624

625
626
627
628
629
630
631

InitializeProcStack (infoPtr, framePtr)
    profInfo_t *infoPtr;
    CallFrame  *framePtr;
{
    if (framePtr == NULL || framePtr->objv == NULL)
        return;
    InitializeProcStack (infoPtr, framePtr->callerPtr);

       
    PushEntry (infoPtr,
               Tcl_GetStringFromObj (framePtr->objv [0], NULL),
               TRUE,
               infoPtr->stackPtr->procLevel + 1,
               framePtr->level,
               UNKNOWN_LEVEL);
︙︙
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857

{
    Interp *iPtr = (Interp *) infoPtr->interp;
    int scopeLevel;
    profEntry_t *scanPtr;

    CleanDataTable (infoPtr);

#ifdef OBJ_AND_NRE
    infoPtr->traceHandle =
        Tcl_CreateObjTrace (infoPtr->interp, MAXINT,
                            infoPtr->commandMode ? 0 :
                            TCL_ALLOW_INLINE_COMPILATION,
                            (Tcl_CmdObjTraceProc *) ProfObjTraceRoutine,
                            (ClientData) infoPtr, NULL);
#else
    infoPtr->traceHandle =
        Tcl_CreateTrace (infoPtr->interp, MAXINT,
                         (Tcl_CmdTraceProc *) ProfTraceRoutine,
                         (ClientData) infoPtr);
#endif
    infoPtr->commandMode = commandMode;
    infoPtr->evalMode = evalMode;
    infoPtr->realTime = 0;
    infoPtr->cpuTime = 0;
    infoPtr->prevRealTime = 0;
    infoPtr->prevCpuTime = 0;
    infoPtr->updatedTimes = FALSE;








<

|
<



<
<
<
<
<
<








651
652
653
654
655
656
657

658
659

660
661
662






663
664
665
666
667
668
669

{
    Interp *iPtr = (Interp *) infoPtr->interp;
    int scopeLevel;
    profEntry_t *scanPtr;

    CleanDataTable (infoPtr);


    infoPtr->traceHandle =
        Tcl_CreateObjTrace (infoPtr->interp, 0,

                            TCL_ALLOW_INLINE_COMPILATION,
                            (Tcl_CmdObjTraceProc *) ProfObjTraceRoutine,
                            (ClientData) infoPtr, NULL);






    infoPtr->commandMode = commandMode;
    infoPtr->evalMode = evalMode;
    infoPtr->realTime = 0;
    infoPtr->cpuTime = 0;
    infoPtr->prevRealTime = 0;
    infoPtr->prevCpuTime = 0;
    infoPtr->updatedTimes = FALSE;
︙︙
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135





1136


    infoPtr = (profInfo_t *) ckalloc (sizeof (profInfo_t));

    infoPtr->interp = interp;
    infoPtr->traceHandle = NULL;
    infoPtr->commandMode = FALSE;
    infoPtr->evalMode = FALSE;
    infoPtr->currentCmdPtr = NULL;
    infoPtr->savedStrCmdProc = NULL;
    infoPtr->savedStrCmdClientData = NULL;
    infoPtr->savedObjCmdProc = NULL;
#ifdef OBJ_AND_NRE
    infoPtr->savedNreProc = NULL;
#endif
    infoPtr->savedObjCmdClientData = NULL;
    infoPtr->evalLevel = UNKNOWN_LEVEL;
    infoPtr->realTime = 0;
    infoPtr->cpuTime = 0;
    infoPtr->prevRealTime = 0;
    infoPtr->prevCpuTime = 0;
    infoPtr->updatedTimes = FALSE;
    infoPtr->stackPtr = NULL;
    infoPtr->stackSize = 0;
    infoPtr->scopeChainPtr = NULL;
    Tcl_InitHashTable (&infoPtr->profDataTable, TCL_STRING_KEYS);

    Tcl_CallWhenDeleted (interp, ProfMonCleanUp, (ClientData) infoPtr);

    Tcl_CreateObjCommand (interp, 
                          "profile",
                          TclX_ProfileObjCmd,
                          (ClientData) infoPtr,
                          (Tcl_CmdDeleteProc*) NULL);





}








|
<
<
<
<
<
<
<













|
|
|
|
|
>
>
>
>
>


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


    infoPtr = (profInfo_t *) ckalloc (sizeof (profInfo_t));

    infoPtr->interp = interp;
    infoPtr->traceHandle = NULL;
    infoPtr->commandMode = FALSE;
    infoPtr->evalMode = FALSE;
    infoPtr->currentCmd = NULL;







    infoPtr->evalLevel = UNKNOWN_LEVEL;
    infoPtr->realTime = 0;
    infoPtr->cpuTime = 0;
    infoPtr->prevRealTime = 0;
    infoPtr->prevCpuTime = 0;
    infoPtr->updatedTimes = FALSE;
    infoPtr->stackPtr = NULL;
    infoPtr->stackSize = 0;
    infoPtr->scopeChainPtr = NULL;
    Tcl_InitHashTable (&infoPtr->profDataTable, TCL_STRING_KEYS);

    Tcl_CallWhenDeleted (interp, ProfMonCleanUp, (ClientData) infoPtr);

    infoPtr->profileCmd = Tcl_CreateObjCommand (interp, 
                                                "profile",
                                                TclX_ProfileObjCmd,
                                                (ClientData) infoPtr,
                                                (Tcl_CmdDeleteProc *) NULL);
    infoPtr->profExecCmd = Tcl_CreateObjCommand (interp, 
                                                 "profexec",
                                                 ProfExecObjCmd,
                                                 (ClientData) infoPtr,
                                                 (Tcl_CmdDeleteProc *) NULL);
}
Changes to jni/tclx/generic/tclXstring.c.
︙︙
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689

    Tcl_Obj *classObj, *stringObj;
    int number;
    char charBuf[TCL_UTF_MAX];
    Tcl_UniChar uniChar;

#define IS_8BIT_UNICHAR(c) (c <= 255)

    if (TCL_UTF_MAX > sizeof(number)) {
        panic("TclX_CtypeObjCmd: UTF character longer than a int");
    }

    /*FIX: Split into multiple procs */
    /*FIX: Should use UtfNext to walk string */

    if (objc < 3) {
        goto wrongNumArgs;
    }









<
<
<
<








672
673
674
675
676
677
678




679
680
681
682
683
684
685

    Tcl_Obj *classObj, *stringObj;
    int number;
    char charBuf[TCL_UTF_MAX];
    Tcl_UniChar uniChar;

#define IS_8BIT_UNICHAR(c) (c <= 255)





    /*FIX: Split into multiple procs */
    /*FIX: Should use UtfNext to walk string */

    if (objc < 3) {
        goto wrongNumArgs;
    }
︙︙
Changes to jni/tclx/tests/profile.test.
︙︙
141
142
143
144
145
146
147

148
149
150
151
152
153
154
155
156
157




158
159
160
161
162
163
164

    set sumData {}
    foreach stack [array names profData] {
	set newStack [FilterProfStack $stack]
	if {![lempty $newStack]} {
	    lappend sumData [list $newStack [lindex $profData($stack) 0]]
	}
    }

    return [lsort $sumData]
}

proc listRemovePrecomp {args} {
    if {$::tcl_version < 8.4} { return $args }
    # This removes commands that are now compiled, and thus don't
    # appear in the profile results
    set res {}
    foreach arg $args {
	if {[regexp {^::(list|string|return)$} [lindex $arg 0 0]]} continue




	lappend res $arg
    }
    return $res
}

#
# Test of normal procedure calls.








>
|









>
>
>
>








141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169

    set sumData {}
    foreach stack [array names profData] {
	set newStack [FilterProfStack $stack]
	if {![lempty $newStack]} {
	    lappend sumData [list $newStack [lindex $profData($stack) 0]]
	}
    }
    if {$::tcl_version < 8.5} { return [lsort $sumData] }
    return [lsort [listRemovePrecomp {*}$sumData]]
}

proc listRemovePrecomp {args} {
    if {$::tcl_version < 8.4} { return $args }
    # This removes commands that are now compiled, and thus don't
    # appear in the profile results
    set res {}
    foreach arg $args {
	if {[regexp {^::(list|string|return)$} [lindex $arg 0 0]]} continue
	# 8.6
	if {[regexp {^::(expr|error|incr|set|list|catch|for|if|tcl::)} [lindex $arg 0 0]]} continue
	# 8.6, remove unwanted stuff in between, very ugly
	regsub -all -- {( ::if| ::catch| ::error)} $arg "" arg
	lappend res $arg
    }
    return $res
}

#
# Test of normal procedure calls.
︙︙
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

} [list {<global> 1} {<global> 1} \
	{{::ProcA4 <global>} 1} \
	{{::ProcB4 ::ProcA4 <global>} 1} \
	{{::ProcC4 ::ProcB4 ::ProcA4 <global>} 1} \
	{{::ProcD4 ::ProcC4 ::ProcB4 ::ProcA4 <global>} 1} \
	{{::ProcE4 ::ProcB4 ::ProcA4 <global>} 1}]














test profile-4.2 {profile count tests} {
   profile -commands on
   ProcA4
   profile off profData
   SumCntData profData
} [list {<global> 1} {<global> 1} \
	{{::ProcA4 <global>} 1} \
	{{::ProcB4 ::ProcA4 <global>} 1} \
	{{::ProcC4 ::ProcB4 ::ProcA4 <global>} 1} \
	{{::ProcD4 ::ProcC4 ::ProcB4 ::ProcA4 <global>} 1} \
	{{::ProcE4 ::ProcB4 ::ProcA4 <global>} 1} \
	{{::error ::ProcD4 ::ProcC4 ::ProcB4 ::ProcA4 <global>} 1} \
	{{::profile <global>} 1}]

test profile-4.3 {profile count tests} {
   profile -eval on
   ProcA4
   profile off profData
   SumCntData profData
} [list {<global> 1} {<global> 1} \
	{{::ProcA4 <global>} 1} \
	{{::ProcB4 ::ProcA4 <global>} 1} \
	{{::ProcC4 ::ProcB4 ::ProcA4 <global>} 1} \
	{{::ProcD4 ::ProcC4 ::ProcB4 ::ProcA4 <global>} 1} \
	{{::ProcE4 ::ProcB4 ::ProcA4 <global>} 1}]

test profile-4.4 {profile count tests} {
   profile -commands -eval on
   ProcA4
   profile off profData
   SumCntData profData
} [list {<global> 1} {<global> 1} \
	{{::ProcA4 <global>} 1} \
	{{::ProcB4 ::ProcA4 <global>} 1} \
	{{::ProcC4 ::ProcB4 ::ProcA4 <global>} 1} \
	{{::ProcD4 ::ProcC4 ::ProcB4 ::ProcA4 <global>} 1} \
	{{::ProcE4 ::ProcB4 ::ProcA4 <global>} 1} \
	{{::error ::ProcD4 ::ProcC4 ::ProcB4 ::ProcA4 <global>} 1} \
	{{::profile <global>} 1}]

#
# Test of a command that calls procedures from different levels.
#
set ::tcltest::testConstraints(tclx_test_eval) \
	[llength [info commands tclx_test_eval]]









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





<
|
<
<
<
<
<
<


















<
|
<
<
<
<
<
<








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

} [list {<global> 1} {<global> 1} \
	{{::ProcA4 <global>} 1} \
	{{::ProcB4 ::ProcA4 <global>} 1} \
	{{::ProcC4 ::ProcB4 ::ProcA4 <global>} 1} \
	{{::ProcD4 ::ProcC4 ::ProcB4 ::ProcA4 <global>} 1} \
	{{::ProcE4 ::ProcB4 ::ProcA4 <global>} 1}]

set anticipate [list {<global> 1} {<global> 1} \
	{{::ProcA4 <global>} 1} \
	{{::ProcB4 ::ProcA4 <global>} 1} \
	{{::ProcC4 ::ProcB4 ::ProcA4 <global>} 1} \
	{{::ProcD4 ::ProcC4 ::ProcB4 ::ProcA4 <global>} 1} \
	{{::ProcE4 ::ProcB4 ::ProcA4 <global>} 1}]
if {$tcl_version < 8.6} {
	# Error-handler is not subject to profiling under 8.6
	lappend anticipate \
	{{::error ::ProcD4 ::ProcC4 ::ProcB4 ::ProcA4 <global>} 1}
}
lappend anticipate {{::profile <global>} 1}

test profile-4.2 {profile count tests} {
   profile -commands on
   ProcA4
   profile off profData
   SumCntData profData

} $anticipate







test profile-4.3 {profile count tests} {
   profile -eval on
   ProcA4
   profile off profData
   SumCntData profData
} [list {<global> 1} {<global> 1} \
	{{::ProcA4 <global>} 1} \
	{{::ProcB4 ::ProcA4 <global>} 1} \
	{{::ProcC4 ::ProcB4 ::ProcA4 <global>} 1} \
	{{::ProcD4 ::ProcC4 ::ProcB4 ::ProcA4 <global>} 1} \
	{{::ProcE4 ::ProcB4 ::ProcA4 <global>} 1}]

test profile-4.4 {profile count tests} {
   profile -commands -eval on
   ProcA4
   profile off profData
   SumCntData profData

} $anticipate







#
# Test of a command that calls procedures from different levels.
#
set ::tcltest::testConstraints(tclx_test_eval) \
	[llength [info commands tclx_test_eval]]
︙︙
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557

proc EatTime {amount} {
    set start [lindex [times] 0]
    set end   [expr $start+$amount]
    set cnt 0
    while {[lindex [times] 0] < $end} {
        format %d 100  ;# kind of slow command.
        incr cnt
        if {($cnt > 10000) && ([lindex [times] 0] == $start)} {
            error "User CPU time does not appear to be accumulating"
        }
    }
}

proc ProcA10 {} {ProcB10;ProcC10;ProcD10}
proc ProcB10 {} {EatTime 1}








|








547
548
549
550
551
552
553
554
555
556
557
558
559
560
561

proc EatTime {amount} {
    set start [lindex [times] 0]
    set end   [expr $start+$amount]
    set cnt 0
    while {[lindex [times] 0] < $end} {
        format %d 100  ;# kind of slow command.
        incr cnt
        if {($cnt > 100000) && ([lindex [times] 0] == $start)} {
            error "User CPU time does not appear to be accumulating"
        }
    }
}

proc ProcA10 {} {ProcB10;ProcC10;ProcD10}
proc ProcB10 {} {EatTime 1}
︙︙
Fossil version [d3896c2acd] 2025-07-09 21:54:20