home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / tcl / tclX6.5c / src / tclXprofile.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-12-19  |  22.0 KB  |  704 lines
  1. /*
  2.  * tclXprofile.c --
  3.  *
  4.  * Tcl performance profile monitor.
  5.  *-----------------------------------------------------------------------------
  6.  * Copyright 1992 Karl Lehenbauer and Mark Diekhans.
  7.  *
  8.  * Permission to use, copy, modify, and distribute this software and its
  9.  * documentation for any purpose and without fee is hereby granted, provided
  10.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11.  * Mark Diekhans make no representations about the suitability of this
  12.  * software for any purpose.  It is provided "as is" without express or
  13.  * implied warranty.
  14.  *-----------------------------------------------------------------------------
  15.  * $Id: tclXprofile.c,v 2.1 1992/12/19 18:34:32 markd Exp $
  16.  *-----------------------------------------------------------------------------
  17.  */
  18.  
  19. #include "tclHash.h"
  20. #include "tclExtdInt.h"
  21.  
  22. /*
  23.  * Stack entry used to keep track of an profiling information for active
  24.  * procedure.  Handling uplevels is tricky.  The eval level and procedure call
  25.  * level are kept track of.  These are used to distinguish between an uplevel
  26.  * and exiting a procedure.  During an uplevel, the invisible part of the
  27.  * profile stack is saved on another stack until the uplevel completes.
  28.  */
  29.  
  30. typedef struct profStackEntry_t {
  31.     long                     realTime;      /* Real time at procedure entry. */
  32.     long                     cpuTime;       /* CPU time at procedure entry.  */
  33.     int                      procLevel;     /* Call level of this procedure  */
  34.     int                      evalLevel;     /* Eval level of this prodecure  */
  35.     struct profStackEntry_t *prevEntryPtr;  /* Previous stack entry.         */
  36.     char                     procName [1];  /* Procedure name. MUST BE LAST! */
  37. } profStackEntry_t;
  38.  
  39.  
  40. /*
  41.  * Save stack entry used to hold profile stack entries during an uplevel.
  42.  */
  43.  
  44. typedef struct saveStackEntry_t {
  45.     profStackEntry_t         *topPtr;        /* Top of saved stack section   */
  46.     profStackEntry_t         *bottomPtr;     /* Bottom of saved stack        */
  47.     struct saveStackEntry_t  *prevEntryPtr;  /* Previous saved stack section */
  48. } saveStackEntry_t;
  49.  
  50. /*
  51.  * Data keeped on a stack snapshot.
  52.  */
  53.  
  54. typedef struct profDataEntry_t {
  55.     long count;
  56.     long realTime;
  57.     long cpuTime;
  58. } profDataEntry_t;
  59.  
  60. /*
  61.  * Client data structure for profile command.  A count of real and CPU time
  62.  * spent outside of the profiling routines is kept to factor out the variable
  63.  * overhead.
  64.  */
  65.  
  66. typedef struct profInfo_t { 
  67.     Tcl_Interp       *interp;            /* Interpreter this is for.         */
  68.     Tcl_Trace         traceHolder;       /* Handle to current trace.         */
  69.     int               allCommands;       /* Prof all commands, not just procs*/
  70.     long              realTime;          /* Real and CPU time counter.       */
  71.     long              cpuTime;
  72.     long              lastRealTime;      /* Real and CPU time of last exit   */
  73.     long              lastCpuTime;       /* from profiling routines.         */
  74.     profStackEntry_t *stackPtr;          /* Pointer to the top of prof stack */
  75.     saveStackEntry_t *saveStackPtr;      /* Frames saved during an uplevel   */
  76.     Tcl_HashTable     profDataTable;     /* Cumulative time table, Keyed by  */
  77.                                          /* call stack list.                 */
  78. } profInfo_t;
  79.  
  80. /*
  81.  * Prototypes of internal functions.
  82.  */
  83.  
  84. static void
  85. ProcEntry _ANSI_ARGS_((profInfo_t *infoPtr,
  86.                        char       *procName,
  87.                        int         procLevel,
  88.                        int         evalLevel));
  89.  
  90. static void
  91. ProcPopEntry _ANSI_ARGS_((profInfo_t *infoPtr));
  92.  
  93. static void
  94. StackSync _ANSI_ARGS_((profInfo_t *infoPtr,
  95.                        int         procLevel,
  96.                        int         evalLevel));
  97.  
  98. static void
  99. DoUplevel _ANSI_ARGS_((profInfo_t *infoPtr,
  100.                        int         procLevel));
  101.  
  102. static void
  103. ProfTraceRoutine _ANSI_ARGS_((ClientData    clientData,
  104.                               Tcl_Interp   *interp,
  105.                               int           evalLevel,
  106.                               char         *command,
  107.                               int           (*cmdProc)(),
  108.                               ClientData    cmdClientData,
  109.                               int           argc,
  110.                               char        **argv));
  111.  
  112. static void
  113. CleanDataTable _ANSI_ARGS_((profInfo_t *infoPtr));
  114.  
  115. static void
  116. DeleteProfTrace _ANSI_ARGS_((profInfo_t *infoPtr));
  117.  
  118. static int
  119. DumpTableData  _ANSI_ARGS_((Tcl_Interp *interp,
  120.                             profInfo_t *infoPtr,
  121.                             char       *varName));
  122.  
  123. static int
  124. Tcl_ProfileCmd _ANSI_ARGS_((ClientData    clientData,
  125.                             Tcl_Interp   *interp,
  126.                             int           argc,
  127.                             char        **argv));
  128.  
  129. static void
  130. CleanUpProfMon _ANSI_ARGS_((ClientData clientData));
  131.  
  132.  
  133. /*
  134.  *-----------------------------------------------------------------------------
  135.  *
  136.  * ProcEntry --
  137.  *   Push a procedure entry onto the stack.
  138.  *
  139.  * Parameters:
  140.  *   o infoPtr (I/O) - The global profiling info.
  141.  *   o procName (I)  The procedure name.
  142.  *   o procLevel (I) - The procedure call level that the procedure will
  143.  *     execute at.
  144.  *   o evalLevel (I) - The eval level that the procedure will start
  145.  *     executing at.
  146.  *-----------------------------------------------------------------------------
  147.  */
  148. static void
  149. ProcEntry (infoPtr, procName, procLevel, evalLevel)
  150.     profInfo_t *infoPtr;
  151.     char       *procName;
  152.     int         procLevel;
  153.     int         evalLevel;
  154. {
  155.     profStackEntry_t *entryPtr;
  156.  
  157.     /*
  158.      * Calculate the size of an entry.  One byte for name is in the entry.
  159.      */
  160.     entryPtr = (profStackEntry_t *) ckalloc (sizeof (profStackEntry_t) +
  161.                                              strlen (procName));
  162.     
  163.     /*
  164.      * Fill it in and push onto the stack.  Note that the procedures frame has
  165.      * not yet been layed down or the procedure body eval execute, so the value
  166.      * they will be in the procedure is recorded.
  167.      */
  168.     entryPtr->realTime     = infoPtr->realTime;
  169.     entryPtr->cpuTime      = infoPtr->cpuTime;
  170.     entryPtr->procLevel    = procLevel;
  171.     entryPtr->evalLevel    = evalLevel;
  172.     strcpy (entryPtr->procName, procName);
  173.  
  174.     entryPtr->prevEntryPtr  = infoPtr->stackPtr;
  175.     infoPtr->stackPtr       = entryPtr;
  176. }
  177.  
  178. /*
  179.  *-----------------------------------------------------------------------------
  180.  *
  181.  * ProcPopEntry --
  182.  *   Pop the procedure entry from the top of the stack and record its
  183.  * times in the data table.
  184.  *
  185.  * Parameters:
  186.  *   o infoPtr (I/O) - The global profiling info.
  187.  *-----------------------------------------------------------------------------
  188.  */
  189. static void
  190. ProcPopEntry (infoPtr)
  191.     profInfo_t *infoPtr;
  192. {
  193.     profStackEntry_t *entryPtr = infoPtr->stackPtr;
  194.     profStackEntry_t *scanPtr;
  195.     int               idx, newEntry;
  196.     char             *stackListPtr;
  197.     Tcl_HashEntry    *hashEntryPtr;
  198.     profDataEntry_t  *dataEntryPtr;
  199.     char             *stackArgv [MAX_NESTING_DEPTH];
  200.  
  201.     /*
  202.      * Build up a stack list.  Entry [0] is the top of the stack.
  203.      */
  204.     idx= 0;
  205.     scanPtr = entryPtr;
  206.     while (scanPtr != NULL) {
  207.         stackArgv [idx] = scanPtr->procName;
  208.         idx++;
  209.         scanPtr = scanPtr->prevEntryPtr;
  210.     }
  211.     stackListPtr = Tcl_Merge (idx, stackArgv);
  212.  
  213.     /*
  214.      * Check the hash table for this entry, either finding an existing or
  215.      * creating a new hash entry.
  216.      */
  217.  
  218.     hashEntryPtr = Tcl_CreateHashEntry (&infoPtr->profDataTable,
  219.                                         stackListPtr,
  220.                                         &newEntry);
  221.     ckfree (stackListPtr);
  222.  
  223.     /*
  224.      * Fill in or increment the entry.
  225.      */
  226.     if (newEntry) {
  227.         dataEntryPtr = (profDataEntry_t *) ckalloc (sizeof (profDataEntry_t));
  228.         Tcl_SetHashValue (hashEntryPtr, dataEntryPtr);
  229.         dataEntryPtr->count    = 0;
  230.         dataEntryPtr->realTime = 0;
  231.         dataEntryPtr->cpuTime  = 0;;
  232.     } else
  233.         dataEntryPtr = (profDataEntry_t *) Tcl_GetHashValue (hashEntryPtr);
  234.  
  235.     dataEntryPtr->count++;
  236.     dataEntryPtr->realTime += (infoPtr->realTime - entryPtr->realTime);
  237.     dataEntryPtr->cpuTime  += (infoPtr->cpuTime  - entryPtr->cpuTime);
  238.  
  239.  
  240.     infoPtr->stackPtr = entryPtr->prevEntryPtr;
  241.     ckfree ((char *) entryPtr);
  242. }
  243.  
  244. /*
  245.  *-----------------------------------------------------------------------------
  246.  *
  247.  * StackSync --
  248.  *   Synchronize the profile stack with the interpreter procedure stack.
  249.  * This is done once return from uplevels, exits and error unwinds are
  250.  * detected (the command after).  Saved profile stack entries may be
  251.  * restored and procedure entries popped from the stack.  When entries
  252.  * are popped, their statistics is saved in stack.
  253.  *
  254.  * Parameters:
  255.  *   o infoPtr (I/O) - The global profiling info.
  256.  *   o procLevel (I) - Procedure call level to return to (zero to clear stack).
  257.  *   o evalLevel (I) - Eval call level to return to (zero to clear stack).
  258.  *-----------------------------------------------------------------------------
  259.  */
  260. static void
  261. StackSync (infoPtr, procLevel, evalLevel)
  262.     profInfo_t *infoPtr;
  263.     int         procLevel;
  264.     int         evalLevel;
  265. {
  266.     saveStackEntry_t *saveEntryPtr;
  267.     
  268.     while (TRUE) {
  269.         /*
  270.          * Move top of saved stack to standard stack if stack is empty or
  271.          * saved eval level is greater than the top of the standard stack.
  272.          */
  273.         saveEntryPtr = infoPtr->saveStackPtr;
  274.  
  275.         if ((saveEntryPtr != NULL) && 
  276.             ((infoPtr->stackPtr == NULL) || 
  277.              (saveEntryPtr->topPtr->evalLevel >
  278.               infoPtr->stackPtr->evalLevel))) {
  279.  
  280.             infoPtr->stackPtr = saveEntryPtr->topPtr;
  281.             infoPtr->saveStackPtr = saveEntryPtr->prevEntryPtr;
  282.             ckfree ((char *) saveEntryPtr);
  283.  
  284.         } else {
  285.  
  286.             if ((infoPtr->stackPtr == NULL) ||
  287.                 ((procLevel >= infoPtr->stackPtr->procLevel) &&
  288.                  (evalLevel >= infoPtr->stackPtr->evalLevel)))
  289.                 break;  /* Done */
  290.             ProcPopEntry (infoPtr);
  291.  
  292.         }
  293.     }
  294. }
  295.  
  296. /*
  297.  *-----------------------------------------------------------------------------
  298.  *
  299.  * DoUplevel --
  300.  *
  301.  *   Do processing required when an uplevel is detected.  Builds and
  302.  * pushes a save stack containing all of the save entrys that have been
  303.  * hiden by the uplevel.  
  304.  *
  305.  * Parameters:
  306.  *   o infoPtr (I/O) - The global profiling info.
  307.  *   o procLevel (I) - The upleveled procedure call level.
  308.  *-----------------------------------------------------------------------------
  309.  */
  310. static void
  311. DoUplevel (infoPtr, procLevel)
  312.     profInfo_t *infoPtr;
  313.     int         procLevel;
  314. {
  315.     profStackEntry_t *scanPtr, *bottomPtr;
  316.     saveStackEntry_t *saveEntryPtr;
  317.  
  318.     /*
  319.      * Find the stack area to save.
  320.      */
  321.     bottomPtr = NULL;
  322.     scanPtr = infoPtr->stackPtr;
  323.     while ((scanPtr != NULL) && (scanPtr->procLevel > procLevel)) {
  324.         bottomPtr = scanPtr;
  325.         scanPtr = scanPtr->prevEntryPtr;
  326.     }
  327.     if (bottomPtr == NULL)
  328.         panic ("uplevel stack confusion");
  329.  
  330.     /*
  331.      * Save the stack entries in the save stack.
  332.      */
  333.     saveEntryPtr = (saveStackEntry_t *) ckalloc (sizeof (saveStackEntry_t));
  334.     saveEntryPtr->topPtr       = infoPtr->stackPtr;
  335.     saveEntryPtr->bottomPtr    = bottomPtr;
  336.     saveEntryPtr->prevEntryPtr = infoPtr->saveStackPtr;;
  337.  
  338.     infoPtr->saveStackPtr = saveEntryPtr;
  339.  
  340.     /*
  341.      * Hide the stack entries.
  342.      */
  343.     infoPtr->stackPtr = bottomPtr->prevEntryPtr;
  344.  
  345. }
  346.  
  347. /*
  348.  *-----------------------------------------------------------------------------
  349.  *
  350.  * ProfTraceRoutine --
  351.  *  Routine called by Tcl_Eval to do profiling.
  352.  *
  353.  *-----------------------------------------------------------------------------
  354.  */
  355. static void
  356. ProfTraceRoutine (clientData, interp, evalLevel, command, cmdProc,
  357.                   cmdClientData, argc, argv)
  358.     ClientData    clientData;
  359.     Tcl_Interp   *interp;
  360.     int           evalLevel;
  361.     char         *command;
  362.     int           (*cmdProc)();
  363.     ClientData    cmdClientData;
  364.     int           argc;
  365.     char        **argv;
  366. {
  367.     Interp      *iPtr      = (Interp *) interp;
  368.     struct tms   cpuTimes;
  369.     profInfo_t  *infoPtr   = (profInfo_t *) clientData;
  370.     int          procLevel = (iPtr->varFramePtr == NULL) ? 0 : 
  371.                              iPtr->varFramePtr->level;
  372.  
  373.     /*
  374.      * Calculate the time spent since the last trace.
  375.      */
  376.     infoPtr->realTime += times (&cpuTimes) - infoPtr->lastRealTime;
  377.     infoPtr->cpuTime  += (cpuTimes.tms_utime + cpuTimes.tms_stime) -
  378.                          infoPtr->lastCpuTime;
  379.  
  380.     
  381.     /*
  382.      * If the procedure level has changed, then something is up.  Its not a
  383.      * procedure call, as we head them off before they happen.  Its one of
  384.      * four events.
  385.      *
  386.      *   o A uplevel command was executed.
  387.      *   o Returned from an uplevel.
  388.      *   o A procedure exit has occured.
  389.      *   o An error unwind has occured.
  390.      *     
  391.      * Eval level must be tested as well as proc level to cover upleveled
  392.      * proc calls that don't execute any commands.
  393.      */
  394.      
  395.     if ((infoPtr->stackPtr != NULL) && 
  396.         ((procLevel != infoPtr->stackPtr->procLevel) ||
  397.          (evalLevel <  infoPtr->stackPtr->evalLevel))) {
  398.  
  399.         if ((procLevel < infoPtr->stackPtr->procLevel) &&
  400.             (evalLevel > infoPtr->stackPtr->evalLevel))
  401.             DoUplevel (infoPtr, procLevel);
  402.         else
  403.             StackSync (infoPtr, procLevel, evalLevel);
  404.     }
  405.  
  406.     /*
  407.      * If this is level zero and the stack is empty, add an entry for the
  408.      * global level.  This takes care of the first command at the global level
  409.      * after profiling has been enabled or the case where profiling was
  410.      * enabled in a proc and we have returned to the global level.
  411.      */
  412.      if ((infoPtr->stackPtr == NULL) && (procLevel == 0))
  413.          ProcEntry (infoPtr, "<global>", 0, evalLevel);
  414.  
  415.     /*
  416.      * If this command is a procedure or if all commands are being traced,
  417.      * handle the entry.
  418.      */
  419.  
  420.     if (infoPtr->allCommands || (TclFindProc (iPtr, argv [0]) != NULL))
  421.         ProcEntry (infoPtr, argv [0], procLevel + 1, evalLevel + 1);
  422.  
  423.     /*
  424.      * Save the exit time of the profiling trace handler.
  425.      */
  426.     infoPtr->lastRealTime = times (&cpuTimes);
  427.     infoPtr->lastCpuTime  = cpuTimes.tms_utime + cpuTimes.tms_stime;
  428.  
  429. }
  430.  
  431. /*
  432.  *-----------------------------------------------------------------------------
  433.  *
  434.  * CleanDataTable --
  435.  *
  436.  *  Clean up the hash data table, releasing all resources and setting it
  437.  *  to the empty state.
  438.  *
  439.  * Parameters:
  440.  *   o infoPtr (I/O) - The global profiling info.
  441.  *-----------------------------------------------------------------------------
  442.  */
  443. static void
  444. CleanDataTable (infoPtr)
  445.     profInfo_t *infoPtr;
  446. {
  447.     Tcl_HashEntry    *hashEntryPtr;
  448.     Tcl_HashSearch   searchCookie;
  449.  
  450.     hashEntryPtr = Tcl_FirstHashEntry (&infoPtr->profDataTable,
  451.                                        &searchCookie);
  452.     while (hashEntryPtr != NULL) {
  453.         ckfree ((char *) Tcl_GetHashValue (hashEntryPtr));
  454.         Tcl_DeleteHashEntry (hashEntryPtr);
  455.         hashEntryPtr = Tcl_NextHashEntry (&searchCookie);
  456.     }
  457. }
  458.  
  459. /*
  460.  *-----------------------------------------------------------------------------
  461.  *
  462.  * DeleteProfTrace --
  463.  *
  464.  *   Delete the profile trace and clean up the stack, logging all procs
  465.  * as if they had exited.  Data table must still be available.
  466.  *
  467.  * Parameters:
  468.  *   o infoPtr (I/O) - The global profiling info.
  469.  *-----------------------------------------------------------------------------
  470.  */
  471. static void
  472. DeleteProfTrace (infoPtr)
  473.     profInfo_t *infoPtr;
  474. {
  475.     Tcl_DeleteTrace (infoPtr->interp, infoPtr->traceHolder);
  476.     infoPtr->traceHolder = NULL;
  477.  
  478.     StackSync (infoPtr, 0, 0);
  479.  
  480. }
  481.  
  482. /*
  483.  *-----------------------------------------------------------------------------
  484.  *
  485.  * DumpTableData --
  486.  *
  487.  *   Dump the table data to an array variable.  Entries will be deleted
  488.  * as they are dumped to limit memory utilization.
  489.  *
  490.  * Parameters:
  491.  *   o interp (I) - Pointer to the interprer.
  492.  *   o infoPtr (I/O) - The global profiling info.
  493.  *   o varName (I) - The name of the variable to save the data in.
  494.  * Returns:
  495.  *   Standard Tcl command results
  496.  *-----------------------------------------------------------------------------
  497.  */
  498. static int
  499. DumpTableData (interp, infoPtr, varName)
  500.     Tcl_Interp *interp;
  501.     profInfo_t *infoPtr;
  502.     char       *varName;
  503. {
  504.     Tcl_HashEntry    *hashEntryPtr;
  505.     Tcl_HashSearch    searchCookie;
  506.     profDataEntry_t  *dataEntryPtr;
  507.     char             *dataArgv [3], *dataListPtr;
  508.     char              countBuf [32], realTimeBuf [32], cpuTimeBuf [32];
  509.  
  510.     dataArgv [0] = countBuf;
  511.     dataArgv [1] = realTimeBuf;
  512.     dataArgv [2] = cpuTimeBuf;
  513.  
  514.     Tcl_UnsetVar (interp, varName, 0);
  515.     hashEntryPtr = Tcl_FirstHashEntry (&infoPtr->profDataTable,
  516.                                        &searchCookie);
  517.     while (hashEntryPtr != NULL) {
  518.         dataEntryPtr = 
  519.             (profDataEntry_t *) Tcl_GetHashValue (hashEntryPtr);
  520.  
  521.         sprintf (countBuf,    "%ld", dataEntryPtr->count);
  522.         sprintf (realTimeBuf, "%ld", dataEntryPtr->realTime * MS_PER_TICK);
  523.         sprintf (cpuTimeBuf,  "%ld", dataEntryPtr->cpuTime  * MS_PER_TICK);
  524.  
  525.         dataListPtr = Tcl_Merge (3, dataArgv);
  526.  
  527.         if (Tcl_SetVar2 (interp, varName,
  528.                          Tcl_GetHashKey (&infoPtr->profDataTable,
  529.                                          hashEntryPtr),
  530.                          dataListPtr, TCL_LEAVE_ERR_MSG) == NULL) {
  531.             ckfree (dataListPtr);
  532.             return TCL_ERROR;
  533.         }
  534.         ckfree (dataListPtr);
  535.         ckfree ((char *) dataEntryPtr);
  536.         Tcl_DeleteHashEntry (hashEntryPtr);
  537.  
  538.         hashEntryPtr = Tcl_NextHashEntry (&searchCookie);
  539.     }
  540.  
  541.     return TCL_OK;
  542. }
  543.  
  544. /*
  545.  *-----------------------------------------------------------------------------
  546.  *
  547.  * Tcl_ProfileCmd --
  548.  *     Implements the TCL profile command:
  549.  *     profile on
  550.  *     profile off arrayvar
  551.  *
  552.  * Results:
  553.  *  Standard TCL results.
  554.  *
  555.  *-----------------------------------------------------------------------------
  556.  */
  557. static int
  558. Tcl_ProfileCmd (clientData, interp, argc, argv)
  559.     ClientData    clientData;
  560.     Tcl_Interp   *interp;
  561.     int           argc;
  562.     char        **argv;
  563. {
  564.     Interp      *iPtr = (Interp *) interp;
  565.     profInfo_t  *infoPtr = (profInfo_t *) clientData;
  566.     int          idx;
  567.     int          cmdArgc,   optionsArgc = 0;
  568.     char       **cmdArgv, **optionsArgv = &(argv [1]);
  569.  
  570.     /*
  571.      * Scan for options (currently only one is supported).  Set cmdArgv to
  572.      * contain the rest of the command following the options.
  573.      */
  574.     for (idx = 1; (idx < argc) && (argv [idx][0] == '-'); idx++)
  575.         optionsArgc++;
  576.     cmdArgc = argc - idx;
  577.     cmdArgv = &(argv [idx]);
  578.  
  579.     if (cmdArgc < 1)
  580.         goto wrongArgs;
  581.  
  582.     /*
  583.      * Handle the on command.
  584.      */
  585.     if (STREQU (cmdArgv [0], "on")) {
  586.         int        allCommands = FALSE;
  587.         struct tms cpuTimes;
  588.  
  589.         if ((cmdArgc != 1) || (optionsArgc > 1))
  590.             goto wrongArgs;
  591.  
  592.         if (optionsArgc == 1) {
  593.             if (!STREQU (optionsArgv [0], "-commands")) {
  594.                 Tcl_AppendResult (interp, "expected option of \"-commands\", ",
  595.                                   "got \"", optionsArgv [0], "\"",
  596.                                   (char *) NULL);
  597.                 return TCL_ERROR;
  598.             }
  599.             allCommands = TRUE;
  600.         }
  601.  
  602.         if (infoPtr->traceHolder != NULL) {
  603.             Tcl_AppendResult (interp, "profiling is already enabled",
  604.                               (char *) NULL);
  605.             return TCL_ERROR;
  606.         }
  607.             
  608.         CleanDataTable (infoPtr);
  609.         infoPtr->traceHolder =
  610.             Tcl_CreateTrace (interp, MAXINT,
  611.                              (Tcl_CmdTraceProc *) ProfTraceRoutine,
  612.                              (ClientData) infoPtr);
  613.         infoPtr->realTime = 0;
  614.         infoPtr->cpuTime  = 0;
  615.         infoPtr->lastRealTime = times (&cpuTimes);
  616.         infoPtr->lastCpuTime  = cpuTimes.tms_utime + cpuTimes.tms_stime;
  617.         infoPtr->allCommands = allCommands;
  618.         return TCL_OK;
  619.     }
  620.  
  621.     /*
  622.      * Handle the off command.  Dump the hash table to a variable.
  623.      */
  624.     if (STREQU (cmdArgv [0], "off")) {
  625.  
  626.         if ((cmdArgc != 2) || (optionsArgc > 0))
  627.             goto wrongArgs;
  628.  
  629.         if (infoPtr->traceHolder == NULL) {
  630.             Tcl_AppendResult (interp, "profiling is not currently enabled",
  631.                               (char *) NULL);
  632.             return TCL_ERROR;
  633.         }
  634.             
  635.         DeleteProfTrace (infoPtr);
  636.  
  637.         if (DumpTableData (interp, infoPtr, argv [2]) != TCL_OK)
  638.             return TCL_ERROR;
  639.         return TCL_OK;
  640.     }
  641.  
  642.     /*
  643.      * Not a valid subcommand.
  644.      */
  645.     Tcl_AppendResult (interp, "expected one of \"on\" or \"off\", got \"",
  646.                       argv [1], "\"", (char *) NULL);
  647.     return TCL_ERROR;
  648.  
  649.   wrongArgs:
  650.     Tcl_AppendResult (interp, tclXWrongArgs, argv [0],
  651.                       " [-commands] on|off arrayVar", (char *) NULL);
  652.     return TCL_ERROR;
  653. }
  654.  
  655. /*
  656.  *-----------------------------------------------------------------------------
  657.  *
  658.  *  CleanUpProfMon --
  659.  *
  660.  *  Release the client data area when the profile command is deleted.
  661.  *
  662.  *-----------------------------------------------------------------------------
  663.  */
  664. static void
  665. CleanUpProfMon (clientData)
  666.     ClientData clientData;
  667. {
  668.     profInfo_t *infoPtr = (profInfo_t *) clientData;
  669.  
  670.     if (infoPtr->traceHolder != NULL)
  671.         DeleteProfTrace (infoPtr);
  672.     CleanDataTable (infoPtr);
  673.     Tcl_DeleteHashTable (&infoPtr->profDataTable);
  674.     ckfree ((char *) infoPtr);
  675. }
  676.  
  677. /*
  678.  *-----------------------------------------------------------------------------
  679.  *
  680.  *  Tcl_InitProfile --
  681.  *
  682.  *  Initialize the Tcl profiling command.
  683.  *
  684.  *-----------------------------------------------------------------------------
  685.  */
  686. void
  687. Tcl_InitProfile (interp)
  688.     Tcl_Interp *interp;
  689. {
  690.     profInfo_t *infoPtr;
  691.  
  692.     infoPtr = (profInfo_t *) ckalloc (sizeof (profInfo_t));
  693.  
  694.     infoPtr->interp       = interp;
  695.     infoPtr->traceHolder  = NULL;
  696.     infoPtr->stackPtr     = NULL;
  697.     infoPtr->saveStackPtr = NULL;
  698.     Tcl_InitHashTable (&infoPtr->profDataTable, TCL_STRING_KEYS);
  699.  
  700.     Tcl_CreateCommand (interp, "profile", Tcl_ProfileCmd, 
  701.                        (ClientData)infoPtr, CleanUpProfMon);
  702. }
  703.  
  704.