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