home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / icon / Source / Iconx / C / Rdebug < prev    next >
Encoding:
Text File  |  1990-07-19  |  6.2 KB  |  277 lines
  1. /*
  2.  * rdebug.c - breakpoint, variable, ttrace, xtrace.
  3.  */
  4.  
  5. #include <math.h>
  6. #include "../h/config.h"
  7. #include "../h/rt.h"
  8. #include "rproto.h"
  9. #include "../h/opdefs.h"
  10.  
  11.  
  12. #ifdef TraceBack
  13. extern struct b_list list_tmp;        /* argument of Op_Apply */
  14. extern struct b_proc *opblks[];
  15. extern word lastop;            /* last op-code */
  16. extern dptr xargp;
  17. extern word xnargs;            /* number of arguments */
  18. extern dptr fnames;
  19. #endif                    /* TraceBack */
  20.  
  21.  
  22. #ifdef TraceBack
  23. /*
  24.  * ttrace - show offending expression.
  25.  */
  26. novalue ttrace()
  27.    {
  28.    struct b_proc *bp;
  29.    word nargs;
  30.  
  31.    fprintf(stderr, "   ");
  32.  
  33.    switch ((int)lastop) {
  34.  
  35.       case Op_Invoke:
  36.          bp = (struct b_proc *)BlkLoc(*xargp);
  37.          nargs = xnargs;
  38.          if (xargp[0].dword == D_Proc)
  39.             putstr(stderr, &(bp->pname));
  40.          else
  41.             outimage(stderr, xargp, 0);
  42.          putc('(', stderr);
  43.          while (nargs--) {
  44.             outimage(stderr, ++xargp, 0);
  45.             if (nargs)
  46.                putc(',', stderr);
  47.             }
  48.          putc(')', stderr);
  49.          break;
  50.  
  51.       case Op_Toby:
  52.          putc('{', stderr);
  53.          outimage(stderr, ++xargp, 0);
  54.          fprintf(stderr, " to ");
  55.          outimage(stderr, ++xargp, 0);
  56.          fprintf(stderr, " by ");
  57.          outimage(stderr, ++xargp, 0);
  58.          putc('}', stderr);
  59.          break;
  60.  
  61.       case Op_Subsc:
  62.          putc('{', stderr);
  63.          outimage(stderr, ++xargp, 0);
  64.          putc('[', stderr);
  65.          outimage(stderr, ++xargp, 0);
  66.          putc(']', stderr);
  67.          putc('}', stderr);
  68.          break;
  69.  
  70.       case Op_Sect:
  71.          putc('{', stderr);
  72.          outimage(stderr, ++xargp, 0);
  73.          putc('[', stderr);
  74.          outimage(stderr, ++xargp, 0);
  75.          putc(':', stderr);
  76.          outimage(stderr, ++xargp, 0);
  77.          putc(']', stderr);
  78.          putc('}', stderr);
  79.          break;
  80.  
  81.       case Op_Bscan:
  82.          putc('{', stderr);
  83.          outimage(stderr, xargp, 0);
  84.          fputs(" ? ..}", stderr);
  85.          break;
  86.  
  87.       case Op_Coact:
  88.          putc('{', stderr);
  89.          outimage(stderr, ++xargp, 0);
  90.          fprintf(stderr, " @ ");
  91.          outimage(stderr, ++xargp, 0);
  92.          putc('}', stderr);
  93.          break;
  94.  
  95.       case Op_Apply:
  96.          outimage(stderr, xargp++, 0);
  97.          fprintf(stderr," ! ");
  98.          outimage(stderr, (dptr)&list_tmp, 0);
  99.          break;
  100.  
  101.       case Op_Create:
  102.          fprintf(stderr,"{create ..}");
  103.          break;
  104.  
  105.       case Op_Field:
  106.          putc('{', stderr);
  107.          outimage(stderr, ++xargp, 0);
  108.          fprintf(stderr, " . ");
  109.          fprintf(stderr, "%s", StrLoc(fnames[IntVal(*++xargp)]));
  110.          putc('}', stderr);
  111.          break;
  112.  
  113.       case Op_Limit:
  114.          fprintf(stderr, "limit counter: ");
  115.          outimage(stderr, xargp, 0);
  116.          break;
  117.  
  118.       case Op_Llist:
  119.          fprintf(stderr,"[ ... ]");
  120.          break;
  121.  
  122.    
  123.       default:
  124.          bp = opblks[lastop];
  125.          nargs = abs((int)bp->nparam);
  126.          putc('{', stderr);
  127.          if (lastop == Op_Bang || lastop == Op_Random)
  128.             goto oneop;
  129.          if (abs((int)bp->nparam) >= 2) {
  130.             outimage(stderr, ++xargp, 0);
  131.             putc(' ', stderr);
  132.             putstr(stderr, &(bp->pname));
  133.             putc(' ', stderr);
  134.            }
  135.          else
  136. oneop:
  137.          putstr(stderr, &(bp->pname));
  138.          outimage(stderr, ++xargp, 0);
  139.          putc('}', stderr);
  140.       }
  141.      
  142.    if (ipc.opnd != NULL)
  143.       fprintf(stderr, " from line %d in %s", findline(ipc.opnd),
  144.          findfile(ipc.opnd));
  145.    putc('\n', stderr);
  146.    fflush(stderr);
  147.    }
  148.  
  149. /*
  150.  * xtrace - procedure *bp is being called with nargs arguments, the first
  151.  *  of which is at arg; produce a trace message.
  152.  */
  153. novalue xtrace(bp, nargs, arg, pline, pfile)
  154. struct b_proc *bp;
  155. word nargs;
  156. dptr arg;
  157. int pline;
  158. char *pfile;
  159.    {
  160.  
  161.    fprintf(stderr, "   ");
  162.    if (bp == NULL)
  163.       fprintf(stderr, "????");
  164.  
  165.    else {
  166.          if (arg[0].dword == D_Proc)
  167.             putstr(stderr, &(bp->pname));
  168.          else
  169.             outimage(stderr, arg, 0);
  170.          arg++;
  171.          putc('(', stderr);
  172.          while (nargs--) {
  173.             outimage(stderr, arg++, 0);
  174.             if (nargs)
  175.                putc(',', stderr);
  176.             }
  177.          putc(')', stderr);
  178.       }
  179.      
  180.    if (pline != 0)
  181.       fprintf(stderr, " from line %d in %s", pline, pfile);
  182.    putc('\n', stderr);
  183.    fflush(stderr);
  184.    }
  185. #endif                     /* TraceBack */
  186.  
  187. /*
  188.  * Service routine to display variables in given number of
  189.  *  procedure calls to file f.
  190.  */
  191.  
  192. novalue xdisp(fp,dp,count,f)
  193.    int count;
  194.    FILE *f;
  195.    struct pf_marker *fp;
  196.    register dptr dp;
  197.    {
  198.    register dptr np;
  199.    register int n;
  200.    struct b_proc *bp;
  201.    extern dptr globals, eglobals;
  202.    extern dptr gnames;
  203.    extern dptr statics;
  204.  
  205.    while (count--) {        /* go back through 'count' frames */
  206.       if (fp == NULL)
  207.          break;       /* needed because &level is wrong in coexpressions */
  208.  
  209.       bp = (struct b_proc *)BlkLoc(*dp); /* get address of procedure block */
  210.  
  211.       /*
  212.        * Print procedure name.
  213.        */
  214.       putstr(f, &(bp->pname));
  215.       fprintf(f, " local identifiers:\n");
  216.  
  217.       /*
  218.        * Print arguments.
  219.        */
  220.       np = bp->lnames;
  221.       for (n = abs(bp->nparam); n > 0; n--) {
  222.          fprintf(f, "   ");
  223.          putstr(f, np);
  224.          fprintf(f, " = ");
  225.          outimage(f, ++dp, 0);
  226.          putc('\n', f);
  227.          np++;
  228.          }
  229.  
  230.       /*
  231.        * Print locals.
  232.        */
  233.       dp = &fp->pf_locals[0];
  234.       for (n = (int)bp->ndynam; n > 0; n--) {
  235.          fprintf(f, "   ");
  236.          putstr(f, np);
  237.          fprintf(f, " = ");
  238.          outimage(f, dp++, 0);
  239.          putc('\n', f);
  240.          np++;
  241.          }
  242.  
  243.       /*
  244.        * Print statics.
  245.        */
  246.       dp = &statics[bp->fstatic];
  247.       for (n = (int)bp->nstatic; n > 0; n--) {
  248.          fprintf(f, "   ");
  249.          putstr(f, np);
  250.          fprintf(f, " = ");
  251.          outimage(f, dp++, 0);
  252.          putc('\n', f);
  253.          np++;
  254.          }
  255.  
  256.       dp = fp->pf_argp;
  257.       fp = fp->pf_pfp;
  258.       }
  259.  
  260.    /*
  261.     * Print globals.
  262.     */
  263.    fprintf(f, "\nglobal identifiers:\n");
  264.    dp = globals;
  265.    np = gnames;
  266.    while (dp < eglobals) {
  267.       fprintf(f, "   ");
  268.       putstr(f, np);
  269.       fprintf(f, " = ");
  270.       outimage(f, dp++, 0);
  271.       putc('\n', f);
  272.       np++;
  273.       }
  274.    fflush(f);
  275.    }
  276.  
  277.