home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / tcl / tclx7_31.z / tclx7_31 / tcldev / tclX7.3a-p1 / src / tclXdebug.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-11-19  |  11.0 KB  |  387 lines
  1. /*
  2.  * tclXdebug.c --
  3.  *
  4.  * Tcl command execution trace command.
  5.  *-----------------------------------------------------------------------------
  6.  * Copyright 1991-1993 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: tclXdebug.c,v 3.0 1993/11/19 06:58:32 markd Rel $
  16.  *-----------------------------------------------------------------------------
  17.  */
  18.  
  19. #include "tclExtdInt.h"
  20.  
  21. /*
  22.  * Client data structure for the cmdtrace command.
  23.  */
  24. #define ARG_TRUNCATE_SIZE 40
  25. #define CMD_TRUNCATE_SIZE 60
  26.  
  27. typedef struct traceInfo_t {
  28.     Tcl_Interp *interp;
  29.     Tcl_Trace   traceHolder;
  30.     int         noEval;
  31.     int         noTruncate;
  32.     int         procCalls;
  33.     int         depth;
  34.     FILE       *filePtr;          /* File to output trace to. */
  35.     } traceInfo_t, *traceInfo_pt;
  36.  
  37. /*
  38.  * Prototypes of internal functions.
  39.  */
  40. static void
  41. PrintStr _ANSI_ARGS_((FILE *filePtr,
  42.                       char *string,
  43.                       int   numChars));
  44.  
  45. static void
  46. PrintArg _ANSI_ARGS_((FILE *filePtr,
  47.                       char *argStr,
  48.                       int   noTruncate));
  49.  
  50. static void
  51. TraceCode  _ANSI_ARGS_((traceInfo_pt traceInfoPtr,
  52.                         int          level,
  53.                         char        *command,
  54.                         int          argc,
  55.                         char       **argv));
  56.  
  57. static void
  58. CmdTraceRoutine _ANSI_ARGS_((ClientData    clientData,
  59.                              Tcl_Interp   *interp,
  60.                              int           level,
  61.                              char         *command,
  62.                              Tcl_CmdProc  *cmdProc,
  63.                              ClientData    cmdClientData,
  64.                              int           argc,
  65.                              char        **argv));
  66.  
  67. static void
  68. DebugCleanUp _ANSI_ARGS_((ClientData  clientData,
  69.                           Tcl_Interp *interp));
  70.  
  71.  
  72. /*
  73.  *-----------------------------------------------------------------------------
  74.  * PrintStr --
  75.  *
  76.  *     Print an string, truncating it to the specified number of characters.
  77.  * If the string contains newlines, \n is substituted.
  78.  *-----------------------------------------------------------------------------
  79.  */
  80. static void
  81. PrintStr (filePtr, string, numChars)
  82.     FILE *filePtr;
  83.     char *string;
  84.     int   numChars;
  85. {
  86.     int idx;
  87.  
  88.     for (idx = 0; idx < numChars; idx++) {
  89.         if (string [idx] == '\n') {
  90.            putc ('\\', filePtr);
  91.            putc ('n', filePtr);
  92.         } else
  93.            putc (string [idx], filePtr);
  94.     }
  95.     if (numChars < strlen (string))
  96.         fprintf (filePtr, "...");
  97. }
  98.  
  99. /*
  100.  *-----------------------------------------------------------------------------
  101.  * PrintArg --
  102.  *
  103.  *   Print an argument string, truncating and adding "..." if its longer
  104.  * then ARG_TRUNCATE_SIZE.  If the string contains white spaces, quote
  105.  * it with angle brackets.
  106.  *-----------------------------------------------------------------------------
  107.  */
  108. static void
  109. PrintArg (filePtr, argStr, noTruncate)
  110.     FILE *filePtr;
  111.     char *argStr;
  112.     int   noTruncate;
  113. {
  114.     int idx, argLen, printLen;
  115.     int quote_it;
  116.  
  117.     argLen = strlen (argStr);
  118.     printLen = argLen;
  119.     if ((!noTruncate) && (printLen > ARG_TRUNCATE_SIZE))
  120.         printLen = ARG_TRUNCATE_SIZE;
  121.  
  122.     quote_it = (printLen == 0);
  123.  
  124.     for (idx = 0; idx < printLen; idx++)
  125.         if (ISSPACE (argStr [idx])) {
  126.             quote_it = TRUE;
  127.             break;
  128.         }
  129.  
  130.     if (quote_it) 
  131.         putc ('{', filePtr);
  132.     PrintStr (filePtr, argStr, printLen);
  133.     if (quote_it) 
  134.         putc ('}', filePtr);
  135. }
  136.  
  137. /*
  138.  *-----------------------------------------------------------------------------
  139.  * TraceCode --
  140.  *
  141.  *   Print out a trace of a code line.  Level is used for indenting
  142.  * and marking lines and may be eval or procedure level.
  143.  *-----------------------------------------------------------------------------
  144.  */
  145. static void
  146. TraceCode (traceInfoPtr, level, command, argc, argv)
  147.     traceInfo_pt traceInfoPtr;
  148.     int          level;
  149.     char        *command;
  150.     int          argc;
  151.     char       **argv;
  152. {
  153.     int idx, cmdLen, printLen;
  154.  
  155.     fprintf (traceInfoPtr->filePtr, "%2d:", level);
  156.  
  157.     if (level > 20)
  158.         level = 20;
  159.     for (idx = 0; idx < level; idx++) 
  160.         fprintf (traceInfoPtr->filePtr, "  ");
  161.  
  162.     if (traceInfoPtr->noEval) {
  163.         cmdLen = printLen = strlen (command);
  164.         if ((!traceInfoPtr->noTruncate) && (printLen > CMD_TRUNCATE_SIZE))
  165.             printLen = CMD_TRUNCATE_SIZE;
  166.  
  167.         PrintStr (traceInfoPtr->filePtr, command, printLen);
  168.       } else {
  169.           for (idx = 0; idx < argc; idx++) {
  170.               if (idx > 0)
  171.                   putc (' ', traceInfoPtr->filePtr);
  172.               PrintArg (traceInfoPtr->filePtr, argv[idx], 
  173.                         traceInfoPtr->noTruncate);
  174.           }
  175.     }
  176.  
  177.     putc ('\n', traceInfoPtr->filePtr);
  178.     fflush (traceInfoPtr->filePtr);
  179.   
  180. }
  181.  
  182. /*
  183.  *-----------------------------------------------------------------------------
  184.  * CmdTraceRoutine --
  185.  *
  186.  *  Routine called by Tcl_Eval to trace a command.
  187.  *-----------------------------------------------------------------------------
  188.  */
  189. static void
  190. CmdTraceRoutine (clientData, interp, level, command, cmdProc, cmdClientData, 
  191.                  argc, argv)
  192.     ClientData    clientData;
  193.     Tcl_Interp   *interp;
  194.     int           level;
  195.     char         *command;
  196.     Tcl_CmdProc  *cmdProc;
  197.     ClientData    cmdClientData;
  198.     int           argc;
  199.     char        **argv;
  200. {
  201.     Interp       *iPtr = (Interp *) interp;
  202.     traceInfo_pt  traceInfoPtr = (traceInfo_pt) clientData;
  203.     int           procLevel;
  204.  
  205.     if (!traceInfoPtr->procCalls) {
  206.         TraceCode (traceInfoPtr, level, command, argc, argv);
  207.     } else {
  208.         if (TclFindProc (iPtr, argv [0]) != NULL) {
  209.             procLevel = (iPtr->varFramePtr == NULL) ? 0 : 
  210.                         iPtr->varFramePtr->level;
  211.             TraceCode (traceInfoPtr, procLevel, command, argc, argv);
  212.         }
  213.     }
  214. }
  215.  
  216. /*
  217.  *-----------------------------------------------------------------------------
  218.  * Tcl_CmdtraceCmd --
  219.  *
  220.  * Implements the TCL trace command:
  221.  *     cmdtrace level|on ?noeval? ?notruncate? ?procs? ?fileid?
  222.  *     cmdtrace off
  223.  *     cmdtrace depth
  224.  *-----------------------------------------------------------------------------
  225.  */
  226. static int
  227. Tcl_CmdtraceCmd (clientData, interp, argc, argv)
  228.     ClientData    clientData;
  229.     Tcl_Interp   *interp;
  230.     int           argc;
  231.     char        **argv;
  232. {
  233.     Interp       *iPtr = (Interp *) interp;
  234.     traceInfo_pt  infoPtr = (traceInfo_pt) clientData;
  235.     int           idx;
  236.     char         *fileHandle;
  237.  
  238.     if (argc < 2)
  239.         goto argumentError;
  240.  
  241.     /*
  242.      * Handle `depth' sub-command.
  243.      */
  244.     if (STREQU (argv[1], "depth")) {
  245.         if (argc != 2)
  246.             goto argumentError;
  247.         sprintf(interp->result, "%d", infoPtr->depth);
  248.         return TCL_OK;
  249.     }
  250.  
  251.     /*
  252.      * If a trace is in progress, delete it now.
  253.      */
  254.     if (infoPtr->traceHolder != NULL) {
  255.         Tcl_DeleteTrace(interp, infoPtr->traceHolder);
  256.         infoPtr->depth = 0;
  257.         infoPtr->traceHolder = NULL;
  258.     }
  259.  
  260.     /*
  261.      * Handle off sub-command.
  262.      */
  263.     if (STREQU (argv[1], "off")) {
  264.         if (argc != 2)
  265.             goto argumentError;
  266.         return TCL_OK;
  267.     }
  268.  
  269.     infoPtr->noEval     = FALSE;
  270.     infoPtr->noTruncate = FALSE;
  271.     infoPtr->procCalls  = FALSE;
  272.     infoPtr->filePtr    = stdout;
  273.     fileHandle          = NULL;
  274.  
  275.     for (idx = 2; idx < argc; idx++) {
  276.         if (STREQU (argv[idx], "notruncate")) {
  277.             if (infoPtr->noTruncate)
  278.                 goto argumentError;
  279.             infoPtr->noTruncate = TRUE;
  280.             continue;
  281.         }
  282.         if (STREQU (argv[idx], "noeval")) {
  283.             if (infoPtr->noEval)
  284.                 goto argumentError;
  285.             infoPtr->noEval = TRUE;
  286.             continue;
  287.         }
  288.         if (STREQU (argv[idx], "procs")) {
  289.             if (infoPtr->procCalls)
  290.                 goto argumentError;
  291.             infoPtr->procCalls = TRUE;
  292.             continue;
  293.         }
  294.         if (STRNEQU (argv [idx], "std", 3) || 
  295.                 STRNEQU (argv [idx], "file", 4)) {
  296.             if (fileHandle != NULL)
  297.                 goto argumentError;
  298.             fileHandle = argv [idx];
  299.             continue;
  300.         }
  301.         goto invalidOption;
  302.     }
  303.  
  304.     if (STREQU (argv[1], "on")) {
  305.         infoPtr->depth = MAXINT;
  306.     } else {
  307.         if (Tcl_GetInt (interp, argv[1], &(infoPtr->depth)) != TCL_OK)
  308.             return TCL_ERROR;
  309.     }
  310.     if (fileHandle != NULL) {
  311.         FILE *filePtr;
  312.  
  313.         if (Tcl_GetOpenFile (interp, fileHandle, 
  314.                              TRUE,   /* Write access */
  315.                              TRUE,   /* Check access */
  316.                              &filePtr) != TCL_OK)
  317.         return TCL_ERROR;
  318.         infoPtr->filePtr = filePtr;
  319.     }
  320.     
  321.     infoPtr->traceHolder = Tcl_CreateTrace (interp, infoPtr->depth,
  322.                                             CmdTraceRoutine,
  323.                                             (ClientData) infoPtr);
  324.     return TCL_OK;
  325.  
  326. argumentError:
  327.     Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  328.                       " level | on ?noeval? ?notruncate? ?procs?",
  329.                       "?fileid? | off | depth", (char *) NULL);
  330.     return TCL_ERROR;
  331.  
  332. invalidOption:
  333.     Tcl_AppendResult (interp, "invalid option: expected ",
  334.                       "one of \"noeval\", \"notruncate\", \"procs\", ",
  335.                       "or a file id", (char *) NULL);
  336.     return TCL_ERROR;
  337. }
  338.  
  339. /*
  340.  *-----------------------------------------------------------------------------
  341.  * DebugCleanUp --
  342.  *
  343.  *  Release the debug data area when the interpreter is deleted.
  344.  *-----------------------------------------------------------------------------
  345.  */
  346. static void
  347. DebugCleanUp (clientData, interp)
  348.     ClientData  clientData;
  349.     Tcl_Interp *interp;
  350. {
  351.     traceInfo_pt infoPtr = (traceInfo_pt) clientData;
  352.  
  353.     if (infoPtr->traceHolder != NULL)
  354.         Tcl_DeleteTrace (infoPtr->interp, infoPtr->traceHolder);
  355.     ckfree ((char *) infoPtr);
  356. }
  357.  
  358. /*
  359.  *-----------------------------------------------------------------------------
  360.  * Tcl_InitDebug --
  361.  *
  362.  *  Initialize the TCL debugging commands.
  363.  *-----------------------------------------------------------------------------
  364.  */
  365. void
  366. Tcl_InitDebug (interp)
  367.     Tcl_Interp *interp;
  368. {
  369.     traceInfo_pt infoPtr;
  370.  
  371.     infoPtr = (traceInfo_pt) ckalloc (sizeof (traceInfo_t));
  372.  
  373.     infoPtr->interp      = interp;
  374.     infoPtr->traceHolder = NULL;
  375.     infoPtr->noEval      = FALSE;
  376.     infoPtr->noTruncate  = FALSE;
  377.     infoPtr->procCalls   = FALSE;
  378.     infoPtr->depth       = 0;
  379.  
  380.     Tcl_CallWhenDeleted (interp, DebugCleanUp, (ClientData) infoPtr);
  381.  
  382.     Tcl_CreateCommand (interp, "cmdtrace", Tcl_CmdtraceCmd, 
  383.                        (ClientData) infoPtr, (void (*)()) NULL);
  384. }
  385.  
  386.  
  387.