home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / src / runtime / rdebug.r < prev    next >
Text File  |  2002-01-18  |  25KB  |  1,048 lines
  1. /*
  2.  * rdebug.r - tracebk, get_name, xdisp, ctrace, rtrace, failtrace, strace,
  3.  *   atrace, cotrace
  4.  */
  5.  
  6. /*
  7.  * Prototypes.
  8.  */
  9. static int     glbcmp    (char *pi, char *pj);
  10. static int     keyref    (union block *bp, dptr dp);
  11. static void showline  (char *f, int l);
  12. static void showlevel (register int n);
  13. static void ttrace    (void);
  14. static void xtrace
  15.    (struct b_proc *bp, word nargs, dptr arg, int pline, char *pfile);
  16.  
  17. /*
  18.  * tracebk - print a trace of procedure calls.
  19.  */
  20. #ifdef PresentationManager
  21. /* have to add COMPILER support too */
  22. void tracebk(void *foo, dptr argp, HWND hwndMLE)
  23. #else                    /* PresentationManager */
  24. void tracebk(lcl_pfp, argp)
  25.  
  26. #if COMPILER
  27. struct p_frame *lcl_pfp;
  28. #else                    /* COMPILER */
  29. struct pf_marker *lcl_pfp;
  30. #endif                    /* COMPILER */
  31.  
  32. dptr argp;
  33. #endif                    /* PresentationManager */
  34.    {
  35.    struct b_proc *cproc;
  36.  
  37. #if COMPILER
  38.  
  39.    struct debug *debug;
  40.    word nparam;
  41.  
  42.    if (lcl_pfp == NULL)
  43.       return;
  44.    debug = PFDebug(*lcl_pfp);
  45.    tracebk(lcl_pfp->old_pfp, lcl_pfp->old_argp);
  46.    cproc = debug->proc;
  47.    xtrace(cproc, (word)abs((int)cproc->nparam), argp, debug->old_line,
  48.       debug->old_fname);
  49.  
  50. #else                    /* COMPILER */
  51.  
  52.    struct pf_marker *origpfp = pfp;
  53.    dptr arg;
  54.    inst cipc;
  55.  
  56.    /*
  57.     * Chain back through the procedure frame markers, looking for the
  58.     *  first one, while building a foward chain of pointers through
  59.     *  the expression frame pointers.
  60.     */
  61.  
  62.    for (pfp->pf_efp = NULL; pfp->pf_pfp != NULL; pfp = pfp->pf_pfp) {
  63.       (pfp->pf_pfp)->pf_efp = (struct ef_marker *)pfp;
  64.       }
  65.  
  66.    /* Now start from the base procedure frame marker, producing a listing
  67.     *  of the procedure calls up through the last one.
  68.     */
  69.  
  70.    while (pfp) {
  71. #ifdef PresentationManager
  72.       /* point at the beginning of the string */
  73.       ConsoleStringBufPtr = ConsoleStringBuf;
  74. #endif                    /* PresentationManager */
  75.       arg = &((dptr)pfp)[-(pfp->pf_nargs) - 1];
  76.       cproc = (struct b_proc *)BlkLoc(arg[0]);
  77.       /*
  78.        * The ipc in the procedure frame points after the "invoke n".
  79.        */
  80.       cipc = pfp->pf_ipc;
  81.       --cipc.opnd;
  82.       --cipc.op;
  83.  
  84.       xtrace(cproc, pfp->pf_nargs, &arg[0], findline(cipc.opnd),
  85.          findfile(cipc.opnd));
  86. #ifdef PresentationManager
  87.       /* insert the text in the MLE */
  88.       WinSendMsg(hwndMLE, MLM_INSERT, MPFROMP(ConsoleStringBuf), (MPARAM)0);
  89. #endif                    /* PresentationManager */
  90.       /*
  91.        * On the last call, show both the call and the offending expression.
  92.        */
  93.       if (pfp == origpfp) {
  94. #ifdef PresentationManager
  95.          /* make sure we are at the beginning of the buffer */
  96.          ConsoleStringBufPtr = ConsoleStringBuf;
  97.          ttrace();
  98.          /* add it to the MLE */
  99.          WinSendMsg(hwndMLE, MLM_INSERT, MPFROMP(ConsoleStringBuf), (MPARAM)0);
  100. #else                    /* PresentationManager */
  101.          ttrace();
  102. #endif                    /* PresentationManager */
  103.          break;
  104.          }
  105.  
  106.       pfp = (struct pf_marker *)(pfp->pf_efp);
  107.       }
  108. #endif                    /* COMPILER */
  109.    }
  110.  
  111. /*
  112.  * xtrace - procedure *bp is being called with nargs arguments, the first
  113.  *  of which is at arg; produce a trace message.
  114.  */
  115. static void xtrace(bp, nargs, arg, pline, pfile)
  116. struct b_proc *bp;
  117. word nargs;
  118. dptr arg;
  119. int pline;
  120. char *pfile;
  121.    {
  122.  
  123. #ifndef PresentationManager
  124.    fprintf(stderr, "   ");
  125. #endif                    /* PresentationManager */
  126.    if (bp == NULL)
  127.       fprintf(stderr, "????");
  128.    else {
  129.  
  130. #if COMPILER
  131.        putstr(stderr, &(bp->pname));
  132. #else                    /* COMPILER */
  133.        if (arg[0].dword == D_Proc)
  134.           putstr(stderr, &(bp->pname));
  135.        else
  136.           outimage(stderr, arg, 0);
  137.        arg++;
  138. #endif                    /* COMPILER */
  139.  
  140.        putc('(', stderr);
  141.        while (nargs--) {
  142.           outimage(stderr, arg++, 0);
  143.           if (nargs)
  144.              putc(',', stderr);
  145.           }
  146.        putc(')', stderr);
  147.        }
  148.  
  149.    if (pline != 0)
  150.       fprintf(stderr, " from line %d in %s", pline, pfile);
  151.    putc('\n', stderr);
  152.    fflush(stderr);
  153.    }
  154.  
  155. /*
  156.  * get_name -- function to get print name of variable.
  157.  */
  158. int get_name(dp1,dp0)
  159.    dptr dp1, dp0;
  160.    {
  161.    dptr dp, varptr;
  162.    tended union block *blkptr;
  163.    dptr arg1;                           /* 1st parameter */
  164.    dptr loc1;                           /* 1st local */
  165.    struct b_proc *proc;                 /* address of procedure block */
  166.    char sbuf[100];            /* buffer; might be too small */
  167.    char *s, *s2;
  168.    word i, j, k;
  169.    int t;
  170.  
  171. #if COMPILER
  172.    arg1 = glbl_argp;
  173.    loc1 = pfp->tend.d;
  174.    proc = PFDebug(*pfp)->proc;
  175. #else                    /* COMPILER */
  176.    arg1 = &glbl_argp[1];
  177.    loc1 = pfp->pf_locals;
  178.    proc = &BlkLoc(*glbl_argp)->proc;
  179. #endif                    /* COMPILER */
  180.  
  181.    type_case *dp1 of {
  182.       tvsubs: {
  183.          blkptr = BlkLoc(*dp1);
  184.          get_name(&(blkptr->tvsubs.ssvar),dp0);
  185.          sprintf(sbuf,"[%ld:%ld]",(long)blkptr->tvsubs.sspos,
  186.             (long)blkptr->tvsubs.sspos+blkptr->tvsubs.sslen);
  187.          k = StrLen(*dp0);
  188.          j = strlen(sbuf);
  189.  
  190.      /*
  191.       * allocate space for both the name and the subscript image,
  192.       *  and then copy both parts into the allocated space
  193.       */
  194.      Protect(s = alcstr(NULL, k + j), return Error);
  195.      s2 = StrLoc(*dp0);
  196.      StrLoc(*dp0) = s;
  197.          StrLen(*dp0) = j + k;
  198.      for (i = 0; i < k; i++)
  199.         *s++ = *s2++;
  200.      s2 = sbuf;
  201.      for (i = 0; i < j; i++)
  202.         *s++ = *s2++;
  203.          }
  204.  
  205.       tvtbl: {
  206.          t = keyref(BlkLoc(*dp1) ,dp0);
  207.          if (t == Error)
  208.             return Error;
  209.           }
  210.  
  211.       kywdint:
  212.          if (VarLoc(*dp1) == &kywd_ran) {
  213.             StrLen(*dp0) = 7;
  214.             StrLoc(*dp0) = "&random";
  215.             }
  216.          else if (VarLoc(*dp1) == &kywd_trc) {
  217.             StrLen(*dp0) = 6;
  218.             StrLoc(*dp0) = "&trace";
  219.             }
  220.  
  221. #ifdef FncTrace
  222.          else if (VarLoc(*dp1) == &kywd_ftrc) {
  223.             StrLen(*dp0) = 7;
  224.             StrLoc(*dp0) = "&ftrace";
  225.             }
  226. #endif                    /* FncTrace */
  227.  
  228.          else if (VarLoc(*dp1) == &kywd_dmp) {
  229.             StrLen(*dp0) = 5;
  230.             StrLoc(*dp0) = "&dump";
  231.             }
  232.          else if (VarLoc(*dp1) == &kywd_err) {
  233.             StrLen(*dp0) = 6;
  234.             StrLoc(*dp0) = "&error";
  235.             }
  236.          else
  237.             syserr("name: unknown integer keyword variable");
  238.  
  239.       kywdevent:
  240. #ifdef MultiThread
  241.          if (VarLoc(*dp1) == &curpstate->eventsource) {
  242.             StrLen(*dp0) = 12;
  243.             StrLoc(*dp0) = "&eventsource";
  244.             }
  245.          else if (VarLoc(*dp1) == &curpstate->eventval) {
  246.             StrLen(*dp0) = 11;
  247.             StrLoc(*dp0) = "&eventvalue";
  248.             }
  249.          else if (VarLoc(*dp1) == &curpstate->eventcode) {
  250.             StrLen(*dp0) = 10;
  251.             StrLoc(*dp0) = "&eventcode";
  252.             }
  253.          else
  254. #endif                    /* MultiThread */
  255.             syserr("name: unknown event keyword variable");
  256.  
  257.       kywdwin: {
  258.          StrLen(*dp0) = 7;
  259.          StrLoc(*dp0) = "&window";
  260.          }
  261.  
  262.       kywdstr: {
  263.          StrLen(*dp0) = 9;
  264.          StrLoc(*dp0) = "&progname";
  265.          }
  266.  
  267.       kywdpos: {
  268.          StrLen(*dp0) = 4;
  269.          StrLoc(*dp0) = "&pos";
  270.          }
  271.  
  272.       kywdsubj: {
  273.          StrLen(*dp0) = 8;
  274.          StrLoc(*dp0) = "&subject";
  275.          }
  276.  
  277.       default:
  278.          if (Offset(*dp1) == 0) {
  279.             /*
  280.              * Must be a named variable.
  281.              */
  282.             dp = VarLoc(*dp1);         /* get address of variable */
  283.             if (InRange(globals,dp,eglobals)) {
  284.                *dp0 = gnames[dp - globals];        /* global */
  285.            return GlobalName;
  286.            }
  287.             else if (InRange(statics,dp,estatics)) {
  288.                i = dp - statics - proc->fstatic;    /* static */
  289.                if (i < 0 || i >= proc->nstatic)
  290.                   syserr("name: unreferencable static variable");
  291.                i += abs((int)proc->nparam) + abs((int)proc->ndynam);
  292.                *dp0 = proc->lnames[i];
  293.            return StaticName;
  294.                }
  295.             else if (InRange(arg1, dp, &arg1[abs((int)proc->nparam)])) {
  296.                *dp0 = proc->lnames[dp - arg1];          /* argument */
  297.            return ParamName;
  298.            }
  299.             else if (InRange(loc1, dp, &loc1[proc->ndynam])) {
  300.                *dp0 = proc->lnames[dp - loc1 + abs((int)proc->nparam)];
  301.            return LocalName;
  302.                }
  303.             else
  304.                syserr("name: cannot determine variable name");
  305.             }
  306.          else {
  307.             /*
  308.              * Must be an element of a structure.
  309.              */
  310.             blkptr = (union block *)VarLoc(*dp1);
  311.             varptr = (dptr)((word *)VarLoc(*dp1) + Offset(*dp1));
  312.             switch ((int)BlkType(blkptr)) {
  313.                case T_Lelem:        /* list */
  314.                   i = varptr - &blkptr->lelem.lslots[blkptr->lelem.first] + 1;
  315.                   if (i < 1)
  316.                      i += blkptr->lelem.nslots;
  317. #ifdef ListFix
  318.                   while (BlkType(blkptr->lelem.listprev) == T_Lelem) {
  319. #else                    /* ListFix */
  320.                   while (blkptr->lelem.listprev != NULL) {
  321. #endif                    /* ListFix */
  322.                      blkptr = blkptr->lelem.listprev;
  323.                      i += blkptr->lelem.nused;
  324.                      }
  325. #ifdef ListFix
  326.                   sprintf(sbuf,"list_%d[%ld]",
  327.               (long)blkptr->lelem.listprev->list.id, (long)i);
  328. #else                    /* ListFix */
  329.                   sprintf(sbuf,"L[%ld]", (long)i);
  330. #endif                    /* ListFix */
  331.                   i = strlen(sbuf);
  332.                   Protect(StrLoc(*dp0) = alcstr(sbuf,i), return Error);
  333.                   StrLen(*dp0) = i;
  334.                   break;
  335.                case T_Record:        /* record */
  336.                   i = varptr - blkptr->record.fields;
  337.                   proc = &blkptr->record.recdesc->proc;
  338.  
  339. #ifdef TableFix
  340.                   sprintf(sbuf,"record %s_%d.%s", StrLoc(proc->recname),
  341.               blkptr->record.id,
  342.               StrLoc(proc->lnames[i]));
  343. #else
  344.                   sprintf(sbuf,"%s.%s", StrLoc(proc->recname),
  345.               StrLoc(proc->lnames[i]));
  346. #endif
  347.  
  348.                   i = strlen(sbuf);
  349.                   Protect(StrLoc(*dp0) = alcstr(sbuf,i), return Error);
  350.                   StrLen(*dp0) = i;
  351.                   break;
  352.                case T_Telem:        /* table */
  353.                   t = keyref(blkptr,dp0);
  354.                   if (t == Error)
  355.                       return Error;
  356.                   break;
  357.                default:        /* none of the above */
  358. #ifdef EventMon
  359.                   *dp0 = emptystr;
  360. #else                                   /* EventMon */
  361.                   syserr("name: invalid structure reference");
  362. #endif                                  /* EventMon */
  363.  
  364.                }
  365.            }
  366.       }
  367.    return Succeeded;
  368.    }
  369.  
  370. #if COMPILER
  371. #begdef PTraceSetup()
  372.    struct b_proc *proc;
  373.  
  374.    --k_trace;
  375.    showline(file_name, line_num);
  376.    showlevel(k_level);
  377.    proc = PFDebug(*pfp)->proc; /* get address of procedure block */
  378.    putstr(stderr, &proc->pname);
  379. #enddef
  380.  
  381. /*
  382.  * ctrace - a procedure is being called; produce a trace message.
  383.  */
  384. void ctrace()
  385.    {
  386.    dptr arg;
  387.    int n;
  388.  
  389.    PTraceSetup();
  390.  
  391.    putc('(', stderr);
  392.    arg = glbl_argp;
  393.    n = abs((int)proc->nparam);
  394.    while (n--) {
  395.       outimage(stderr, arg++, 0);
  396.       if (n)
  397.          putc(',', stderr);
  398.       }
  399.    putc(')', stderr);
  400.    putc('\n', stderr);
  401.    fflush(stderr);
  402.    }
  403.  
  404. /*
  405.  * rtrace - a procedure is returning; produce a trace message.
  406.  */
  407.  
  408. void rtrace()
  409.    {
  410.    PTraceSetup();
  411.  
  412.    fprintf(stderr, " returned ");
  413.    outimage(stderr, pfp->rslt, 0);
  414.    putc('\n', stderr);
  415.    fflush(stderr);
  416.    }
  417.  
  418. /*
  419.  * failtrace - procedure named s is failing; produce a trace message.
  420.  */
  421.  
  422. void failtrace()
  423.    {
  424.    PTraceSetup();
  425.  
  426.    fprintf(stderr, " failed\n");
  427.    fflush(stderr);
  428.    }
  429.  
  430. /*
  431.  * strace - a procedure is suspending; produce a trace message.
  432.  */
  433.  
  434. void strace()
  435.    {
  436.    PTraceSetup();
  437.  
  438.    fprintf(stderr, " suspended ");
  439.    outimage(stderr, pfp->rslt, 0);
  440.    putc('\n', stderr);
  441.    fflush(stderr);
  442.    }
  443.  
  444. /*
  445.  * atrace - a procedure is being resumed; produce a trace message.
  446.  */
  447. void atrace()
  448.    {
  449.    PTraceSetup();
  450.  
  451.    fprintf(stderr, " resumed\n");
  452.    fflush(stderr);
  453.    }
  454. #endif                    /* COMPILER */
  455.  
  456. /*
  457.  * keyref(bp,dp) -- print name of subscripted table
  458.  */
  459. static int keyref(bp, dp)
  460.    union block *bp;
  461.    dptr dp;
  462.    {
  463.    char *s, *s2;
  464.    char sbuf[100];            /* buffer; might be too small */
  465.    int len;
  466.  
  467.    if (getimage(&(bp->telem.tref),dp) == Error)
  468.       return Error;
  469.  
  470.    /*
  471.     * Allocate space, and copy the image surrounded by "table_n[" and "]"
  472.     */
  473.    s2 = StrLoc(*dp);
  474.    len = StrLen(*dp);
  475. #ifdef TableFix
  476.    if (BlkType(bp) == T_Tvtbl)
  477.       bp = bp->tvtbl.clink;
  478.    else
  479.       while(BlkType(bp) == T_Telem)
  480.          bp = bp->telem.clink;
  481.    sprintf(sbuf, "table_%d[", bp->table.id);
  482. #else                    /* TableFix */
  483.    strcpy(sbuf, "T[");
  484. #endif                    /* TableFix */
  485.    { char * dest = sbuf + strlen(sbuf);
  486.    strncpy(dest, s2, len);
  487.    dest[len] = '\0';
  488.    }
  489.    strcat(sbuf, "]");
  490.    len = strlen(sbuf);
  491.    Protect(s = alcstr(sbuf, len), return Error);
  492.    StrLoc(*dp) = s;
  493.    StrLen(*dp) = len;
  494.    return Succeeded;
  495.    }
  496.  
  497. #ifdef Coexpr
  498. /*
  499.  * cotrace -- a co-expression context switch; produce a trace message.
  500.  */
  501. void cotrace(ccp, ncp, swtch_typ, valloc)
  502. struct b_coexpr *ccp;
  503. struct b_coexpr *ncp;
  504. int swtch_typ;
  505. dptr valloc;
  506.    {
  507.    struct b_proc *proc;
  508.  
  509. #if !COMPILER
  510.    inst t_ipc;
  511. #endif                    /* !COMPILER */
  512.  
  513.    --k_trace;
  514.  
  515. #if COMPILER
  516.    showline(ccp->file_name, ccp->line_num);
  517.    proc = PFDebug(*ccp->es_pfp)->proc;     /* get address of procedure block */
  518. #else                    /* COMPILER */
  519.  
  520.    /*
  521.     * Compute the ipc of the instruction causing the context switch.
  522.     */
  523.    t_ipc.op = ipc.op - 1;
  524.    showline(findfile(t_ipc.opnd), findline(t_ipc.opnd));
  525.    proc = (struct b_proc *)BlkLoc(*glbl_argp);
  526. #endif                    /* COMPILER */
  527.  
  528.    showlevel(k_level);
  529.    putstr(stderr, &proc->pname);
  530.    fprintf(stderr,"; co-expression_%ld ", (long)ccp->id);
  531.    switch (swtch_typ) {
  532.       case A_Coact:
  533.          fprintf(stderr,": ");
  534.          outimage(stderr, valloc, 0);
  535.          fprintf(stderr," @ ");
  536.          break;
  537.       case A_Coret:
  538.          fprintf(stderr,"returned ");
  539.          outimage(stderr, valloc, 0);
  540.          fprintf(stderr," to ");
  541.          break;
  542.       case A_Cofail:
  543.          fprintf(stderr,"failed to ");
  544.          break;
  545.       }
  546.    fprintf(stderr,"co-expression_%ld\n", (long)ncp->id);
  547.    fflush(stderr);
  548.    }
  549. #endif                    /* Coexpr */
  550.  
  551. /*
  552.  * showline - print file and line number information.
  553.  */
  554. static void showline(f, l)
  555. char *f;
  556. int l;
  557.    {
  558.    int i;
  559.  
  560.    i = (int)strlen(f);
  561.    while (i > 13) {
  562.       f++;
  563.       i--;
  564.       }
  565.    if (l > 0)
  566.       fprintf(stderr, "%-13s: %4d  ",f, l);
  567.    else
  568.       fprintf(stderr, "             :       ");
  569.    }
  570.  
  571. /*
  572.  * showlevel - print "| " n times.
  573.  */
  574. static void showlevel(n)
  575. register int n;
  576.    {
  577.    while (n-- > 0) {
  578.       putc('|', stderr);
  579.       putc(' ', stderr);
  580.       }
  581.    }
  582.  
  583. #if !COMPILER
  584.  
  585. #include "../h/opdefs.h"
  586.  
  587.  
  588. extern struct descrip value_tmp;        /* argument of Op_Apply */
  589. extern struct b_proc *opblks[];
  590.  
  591.  
  592. /*
  593.  * ttrace - show offending expression.
  594.  */
  595. static void ttrace()
  596.    {
  597.    struct b_proc *bp;
  598.    word nargs;
  599.  
  600. #ifndef PresentationManager
  601.    fprintf(stderr, "   ");
  602. #endif                    /* PresentationManager */
  603.  
  604.    switch ((int)lastop) {
  605.  
  606.       case Op_Keywd:
  607.          fprintf(stderr,"bad keyword reference");
  608.          break;
  609.  
  610.       case Op_Invoke:
  611.          bp = (struct b_proc *)BlkLoc(*xargp);
  612.          nargs = xnargs;
  613.          if (xargp[0].dword == D_Proc)
  614.             putstr(stderr, &(bp->pname));
  615.          else
  616.             outimage(stderr, xargp, 0);
  617.          putc('(', stderr);
  618.          while (nargs--) {
  619.             outimage(stderr, ++xargp, 0);
  620.             if (nargs)
  621.                putc(',', stderr);
  622.             }
  623.          putc(')', stderr);
  624.          break;
  625.  
  626.       case Op_Toby:
  627.          putc('{', stderr);
  628.          outimage(stderr, ++xargp, 0);
  629.          fprintf(stderr, " to ");
  630.          outimage(stderr, ++xargp, 0);
  631.          fprintf(stderr, " by ");
  632.          outimage(stderr, ++xargp, 0);
  633.          putc('}', stderr);
  634.          break;
  635.  
  636.       case Op_Subsc:
  637.          putc('{', stderr);
  638.          outimage(stderr, ++xargp, 0);
  639.          putc('[', stderr);
  640.          outimage(stderr, ++xargp, 0);
  641.          putc(']', stderr);
  642.          putc('}', stderr);
  643.          break;
  644.  
  645.       case Op_Sect:
  646.          putc('{', stderr);
  647.          outimage(stderr, ++xargp, 0);
  648.          putc('[', stderr);
  649.          outimage(stderr, ++xargp, 0);
  650.          putc(':', stderr);
  651.          outimage(stderr, ++xargp, 0);
  652.          putc(']', stderr);
  653.          putc('}', stderr);
  654.          break;
  655.  
  656.       case Op_Bscan:
  657.          putc('{', stderr);
  658.          outimage(stderr, xargp, 0);
  659.          fputs(" ? ..}", stderr);
  660.          break;
  661.  
  662.       case Op_Coact:
  663.          putc('{', stderr);
  664.          outimage(stderr, ++xargp, 0);
  665.          fprintf(stderr, " @ ");
  666.          outimage(stderr, ++xargp, 0);
  667.          putc('}', stderr);
  668.          break;
  669.  
  670.       case Op_Apply:
  671.          outimage(stderr, xargp++, 0);
  672.          fprintf(stderr," ! ");
  673.          outimage(stderr, &value_tmp, 0);
  674.          break;
  675.  
  676.       case Op_Create:
  677.          fprintf(stderr,"{create ..}");
  678.          break;
  679.  
  680.       case Op_Field:
  681.          putc('{', stderr);
  682.          outimage(stderr, ++xargp, 0);
  683.          fprintf(stderr, " . ");
  684.      ++xargp;
  685.      if (IntVal(*xargp) == -1)
  686.             fprintf(stderr, "field");
  687.      else
  688.             fprintf(stderr, "%s", StrLoc(fnames[IntVal(*xargp)]));
  689.          putc('}', stderr);
  690.          break;
  691.  
  692.       case Op_Limit:
  693.          fprintf(stderr, "limit counter: ");
  694.          outimage(stderr, xargp, 0);
  695.          break;
  696.  
  697.       case Op_Llist:
  698.          fprintf(stderr,"[ ... ]");
  699.          break;
  700.  
  701.       default:
  702.  
  703.          bp = opblks[lastop];
  704.          nargs = abs((int)bp->nparam);
  705.          putc('{', stderr);
  706.          if (lastop == Op_Bang || lastop == Op_Random)
  707.             goto oneop;
  708.          if (abs((int)bp->nparam) >= 2) {
  709.             outimage(stderr, ++xargp, 0);
  710.             putc(' ', stderr);
  711.             putstr(stderr, &(bp->pname));
  712.             putc(' ', stderr);
  713.         }
  714.          else
  715. oneop:
  716.          putstr(stderr, &(bp->pname));
  717.          outimage(stderr, ++xargp, 0);
  718.          putc('}', stderr);
  719.       }
  720.  
  721.    if (ipc.opnd != NULL)
  722.       fprintf(stderr, " from line %d in %s", findline(ipc.opnd),
  723.          findfile(ipc.opnd));
  724. #ifndef PresentationManager
  725.    putc('\n', stderr);
  726. #endif                    /* PresentationManager */
  727.    fflush(stderr);
  728.    }
  729.  
  730.  
  731. /*
  732.  * ctrace - procedure named s is being called with nargs arguments, the first
  733.  *  of which is at arg; produce a trace message.
  734.  */
  735. void ctrace(dp, nargs, arg)
  736. dptr dp;
  737. int nargs;
  738. dptr arg;
  739.    {
  740.  
  741.    showline(findfile(ipc.opnd), findline(ipc.opnd));
  742.    showlevel(k_level);
  743.    putstr(stderr, dp);
  744.    putc('(', stderr);
  745.    while (nargs--) {
  746.       outimage(stderr, arg++, 0);
  747.       if (nargs)
  748.          putc(',', stderr);
  749.       }
  750.    putc(')', stderr);
  751.    putc('\n', stderr);
  752.    fflush(stderr);
  753.    }
  754.  
  755. /*
  756.  * rtrace - procedure named s is returning *rval; produce a trace message.
  757.  */
  758.  
  759. void rtrace(dp, rval)
  760. dptr dp;
  761. dptr rval;
  762.    {
  763.    inst t_ipc;
  764.  
  765.    /*
  766.     * Compute the ipc of the return instruction.
  767.     */
  768.    t_ipc.op = ipc.op - 1;
  769.    showline(findfile(t_ipc.opnd), findline(t_ipc.opnd));
  770.    showlevel(k_level);
  771.    putstr(stderr, dp);
  772.    fprintf(stderr, " returned ");
  773.    outimage(stderr, rval, 0);
  774.    putc('\n', stderr);
  775.    fflush(stderr);
  776.    }
  777.  
  778. /*
  779.  * failtrace - procedure named s is failing; produce a trace message.
  780.  */
  781.  
  782. void failtrace(dp)
  783. dptr dp;
  784.    {
  785.    inst t_ipc;
  786.  
  787.    /*
  788.     * Compute the ipc of the fail instruction.
  789.     */
  790.    t_ipc.op = ipc.op - 1;
  791.    showline(findfile(t_ipc.opnd), findline(t_ipc.opnd));
  792.    showlevel(k_level);
  793.    putstr(stderr, dp);
  794.    fprintf(stderr, " failed");
  795.    putc('\n', stderr);
  796.    fflush(stderr);
  797.    }
  798.  
  799. /*
  800.  * strace - procedure named s is suspending *rval; produce a trace message.
  801.  */
  802.  
  803. void strace(dp, rval)
  804. dptr dp;
  805. dptr rval;
  806.    {
  807.    inst t_ipc;
  808.  
  809.    /*
  810.     * Compute the ipc of the suspend instruction.
  811.     */
  812.    t_ipc.op = ipc.op - 1;
  813.    showline(findfile(t_ipc.opnd), findline(t_ipc.opnd));
  814.    showlevel(k_level);
  815.    putstr(stderr, dp);
  816.    fprintf(stderr, " suspended ");
  817.    outimage(stderr, rval, 0);
  818.    putc('\n', stderr);
  819.    fflush(stderr);
  820.    }
  821.  
  822. /*
  823.  * atrace - procedure named s is being resumed; produce a trace message.
  824.  */
  825.  
  826. void atrace(dp)
  827. dptr dp;
  828.    {
  829.    inst t_ipc;
  830.  
  831.    /*
  832.     * Compute the ipc of the instruction causing resumption.
  833.     */
  834.    t_ipc.op = ipc.op - 1;
  835.    showline(findfile(t_ipc.opnd), findline(t_ipc.opnd));
  836.    showlevel(k_level);
  837.    putstr(stderr, dp);
  838.    fprintf(stderr, " resumed");
  839.    putc('\n', stderr);
  840.    fflush(stderr);
  841.    }
  842.  
  843. #ifdef Coexpr
  844. /*
  845.  * coacttrace -- co-expression is being activated; produce a trace message.
  846.  */
  847. void coacttrace(ccp, ncp)
  848. struct b_coexpr *ccp;
  849. struct b_coexpr *ncp;
  850.    {
  851.    struct b_proc *bp;
  852.    inst t_ipc;
  853.  
  854.    bp = (struct b_proc *)BlkLoc(*glbl_argp);
  855.    /*
  856.     * Compute the ipc of the activation instruction.
  857.     */
  858.    t_ipc.op = ipc.op - 1;
  859.    showline(findfile(t_ipc.opnd), findline(t_ipc.opnd));
  860.    showlevel(k_level);
  861.    putstr(stderr, &(bp->pname));
  862.    fprintf(stderr,"; co-expression_%ld : ", (long)ccp->id);
  863.    outimage(stderr, (dptr)(sp - 3), 0);
  864.    fprintf(stderr," @ co-expression_%ld\n", (long)ncp->id);
  865.    fflush(stderr);
  866.    }
  867.  
  868. /*
  869.  * corettrace -- return from co-expression; produce a trace message.
  870.  */
  871. void corettrace(ccp, ncp)
  872. struct b_coexpr *ccp;
  873. struct b_coexpr *ncp;
  874.    {
  875.    struct b_proc *bp;
  876.    inst t_ipc;
  877.  
  878.    bp = (struct b_proc *)BlkLoc(*glbl_argp);
  879.    /*
  880.     * Compute the ipc of the coret instruction.
  881.     */
  882.    t_ipc.op = ipc.op - 1;
  883.    showline(findfile(t_ipc.opnd), findline(t_ipc.opnd));
  884.    showlevel(k_level);
  885.    putstr(stderr, &(bp->pname));
  886.    fprintf(stderr,"; co-expression_%ld returned ", (long)ccp->id);
  887.    outimage(stderr, (dptr)(&ncp->es_sp[-3]), 0);
  888.    fprintf(stderr," to co-expression_%ld\n", (long)ncp->id);
  889.    fflush(stderr);
  890.    }
  891.  
  892. /*
  893.  * cofailtrace -- failure return from co-expression; produce a trace message.
  894.  */
  895. void cofailtrace(ccp, ncp)
  896. struct b_coexpr *ccp;
  897. struct b_coexpr *ncp;
  898.    {
  899.    struct b_proc *bp;
  900.    inst t_ipc;
  901.  
  902.    bp = (struct b_proc *)BlkLoc(*glbl_argp);
  903.    /*
  904.     * Compute the ipc of the cofail instruction.
  905.     */
  906.    t_ipc.op = ipc.op - 1;
  907.    showline(findfile(t_ipc.opnd), findline(t_ipc.opnd));
  908.    showlevel(k_level);
  909.    putstr(stderr, &(bp->pname));
  910.    fprintf(stderr,"; co-expression_%ld failed to co-expression_%ld\n",
  911.       (long)ccp->id, (long)ncp->id);
  912.    fflush(stderr);
  913.    }
  914. #endif                    /* Coexpr */
  915. #endif                    /* !COMPILER */
  916.  
  917. /*
  918.  * Service routine to display variables in given number of
  919.  *  procedure calls to file f.
  920.  */
  921.  
  922. int xdisp(fp,dp,count,f)
  923. #if COMPILER
  924.    struct p_frame *fp;
  925. #else                    /* COMPILER */
  926.    struct pf_marker *fp;
  927. #endif                    /* COMPILER */
  928.    register dptr dp;
  929.    int count;
  930.    FILE *f;
  931.    {
  932.    register dptr np;
  933.    register int n;
  934.    struct b_proc *bp;
  935.    word nglobals, *indices;
  936.  
  937.    while (count--) {        /* go back through 'count' frames */
  938.       if (fp == NULL)
  939.          break;       /* needed because &level is wrong in co-expressions */
  940.  
  941. #if COMPILER
  942.       bp = PFDebug(*fp)->proc;    /* get address of procedure block */
  943. #else                    /* COMPILER */
  944.       bp = (struct b_proc *)BlkLoc(*dp++); /* get addr of procedure block */
  945.       /* #%#% was: no post-increment there, but *pre*increment dp below */
  946. #endif                    /* COMPILER */
  947.  
  948.       /*
  949.        * Print procedure name.
  950.        */
  951.       putstr(f, &(bp->pname));
  952.       fprintf(f, " local identifiers:\n");
  953.  
  954.       /*
  955.        * Print arguments.
  956.        */
  957.       np = bp->lnames;
  958.       for (n = abs((int)bp->nparam); n > 0; n--) {
  959.          fprintf(f, "   ");
  960.          putstr(f, np);
  961.          fprintf(f, " = ");
  962.          outimage(f, dp++, 0);
  963.          putc('\n', f);
  964.          np++;
  965.          }
  966.  
  967.       /*
  968.        * Print locals.
  969.        */
  970. #if COMPILER
  971.       dp = fp->tend.d;
  972. #else                    /* COMPILER */
  973.       dp = &fp->pf_locals[0];
  974. #endif                    /* COMPILER */
  975.       for (n = bp->ndynam; n > 0; n--) {
  976.          fprintf(f, "   ");
  977.          putstr(f, np);
  978.          fprintf(f, " = ");
  979.          outimage(f, dp++, 0);
  980.          putc('\n', f);
  981.          np++;
  982.          }
  983.  
  984.       /*
  985.        * Print statics.
  986.        */
  987.       dp = &statics[bp->fstatic];
  988.       for (n = bp->nstatic; n > 0; n--) {
  989.          fprintf(f, "   ");
  990.          putstr(f, np);
  991.          fprintf(f, " = ");
  992.          outimage(f, dp++, 0);
  993.          putc('\n', f);
  994.          np++;
  995.          }
  996.  
  997. #if COMPILER
  998.       dp = fp->old_argp;
  999.       fp = fp->old_pfp;
  1000. #else                    /* COMPILER */
  1001.       dp = fp->pf_argp;
  1002.       fp = fp->pf_pfp;
  1003. #endif                    /* COMPILER */
  1004.       }
  1005.  
  1006.    /*
  1007.     * Print globals.  Sort names in lexical order using temporary index array.
  1008.     */
  1009.  
  1010. #if COMPILER
  1011.    nglobals = n_globals;
  1012. #else                    /* COMPILER */
  1013.    nglobals = eglobals - globals;
  1014. #endif                    /* COMPILER */
  1015.  
  1016.    indices = (word *)malloc(nglobals * sizeof(word));
  1017.    if (indices == NULL)
  1018.       return Failed;
  1019.    else {
  1020.       for (n = 0; n < nglobals; n++)
  1021.          indices[n] = n;
  1022.       qsort ((char*)indices, (int)nglobals, sizeof(word), (int (*)())glbcmp);
  1023.       fprintf(f, "\nglobal identifiers:\n");
  1024.       for (n = 0; n < nglobals; n++) {
  1025.          fprintf(f, "   ");
  1026.          putstr(f, &gnames[indices[n]]);
  1027.          fprintf(f, " = ");
  1028.          outimage(f, &globals[indices[n]], 0);
  1029.          putc('\n', f);
  1030.          }
  1031.       fflush(f);
  1032.       free((pointer)indices);
  1033.       }
  1034.    return Succeeded;
  1035.    }
  1036.  
  1037. /*
  1038.  * glbcmp - compare the names of two globals using their temporary indices.
  1039.  */
  1040. static int glbcmp (pi, pj)
  1041. char *pi, *pj;
  1042.    {
  1043.    register word i = *(word *)pi;
  1044.    register word j = *(word *)pj;
  1045.    return lexcmp(&gnames[i], &gnames[j]);
  1046.    }
  1047.  
  1048.