/*
 * rdebug.c - breakpoint, variable, ttrace, xtrace.
 */

#include <math.h>
#include "..\h\config.h"
#include "..\h\rt.h"
#include "rproto.h"
#include "..\h\opdefs.h"


#ifdef TraceBack
extern struct b_list list_tmp;		/* argument of Op_Apply */
extern struct b_proc *opblks[];
extern word lastop;			/* last op-code */
extern dptr xargp;
extern word xnargs;			/* number of arguments */
extern dptr fnames;
#endif					/* TraceBack */


#ifdef TraceBack
/*
 * ttrace - show offending expression.
 */
novalue ttrace()
   {
   struct b_proc *bp;
   word nargs;

   fprintf(stderr, "   ");

   switch ((int)lastop) {

      case Op_Invoke:
         bp = (struct b_proc *)BlkLoc(*xargp);
         nargs = xnargs;
         if (xargp[0].dword == D_Proc)
            putstr(stderr, &(bp->pname));
         else
            outimage(stderr, xargp, 0);
         putc('(', stderr);
         while (nargs--) {
            outimage(stderr, ++xargp, 0);
            if (nargs)
               putc(',', stderr);
            }
         putc(')', stderr);
         break;

      case Op_Toby:
         putc('{', stderr);
         outimage(stderr, ++xargp, 0);
         fprintf(stderr, " to ");
         outimage(stderr, ++xargp, 0);
         fprintf(stderr, " by ");
         outimage(stderr, ++xargp, 0);
         putc('}', stderr);
         break;

      case Op_Subsc:
         putc('{', stderr);
         outimage(stderr, ++xargp, 0);
         putc('[', stderr);
         outimage(stderr, ++xargp, 0);
         putc(']', stderr);
         putc('}', stderr);
         break;

      case Op_Sect:
         putc('{', stderr);
         outimage(stderr, ++xargp, 0);
         putc('[', stderr);
         outimage(stderr, ++xargp, 0);
         putc(':', stderr);
         outimage(stderr, ++xargp, 0);
         putc(']', stderr);
         putc('}', stderr);
         break;

      case Op_Bscan:
         putc('{', stderr);
         outimage(stderr, xargp, 0);
         fputs(" ? ..}", stderr);
         break;

      case Op_Coact:
         putc('{', stderr);
         outimage(stderr, ++xargp, 0);
         fprintf(stderr, " @ ");
         outimage(stderr, ++xargp, 0);
         putc('}', stderr);
         break;

      case Op_Apply:
         outimage(stderr, xargp++, 0);
         fprintf(stderr," ! ");
         outimage(stderr, (dptr)&list_tmp, 0);
         break;

      case Op_Create:
         fprintf(stderr,"{create ..}");
         break;

      case Op_Field:
         putc('{', stderr);
         outimage(stderr, ++xargp, 0);
         fprintf(stderr, " . ");
         fprintf(stderr, "%s", StrLoc(fnames[IntVal(*++xargp)]));
         putc('}', stderr);
         break;

      case Op_Limit:
         fprintf(stderr, "limit counter: ");
         outimage(stderr, xargp, 0);
         break;

      case Op_Llist:
         fprintf(stderr,"[ ... ]");
         break;

   
      default:
         bp = opblks[lastop];
         nargs = abs((int)bp->nparam);
         putc('{', stderr);
         if (lastop == Op_Bang || lastop == Op_Random)
            goto oneop;
         if (abs((int)bp->nparam) >= 2) {
            outimage(stderr, ++xargp, 0);
            putc(' ', stderr);
            putstr(stderr, &(bp->pname));
            putc(' ', stderr);
   	    }
         else
oneop:
         putstr(stderr, &(bp->pname));
         outimage(stderr, ++xargp, 0);
         putc('}', stderr);
      }
	 
   if (ipc.opnd != NULL)
      fprintf(stderr, " from line %d in %s", findline(ipc.opnd),
         findfile(ipc.opnd));
   putc('\n', stderr);
   fflush(stderr);
   }

/*
 * xtrace - procedure *bp is being called with nargs arguments, the first
 *  of which is at arg; produce a trace message.
 */
novalue xtrace(bp, nargs, arg, pline, pfile)
struct b_proc *bp;
word nargs;
dptr arg;
int pline;
char *pfile;
   {

   fprintf(stderr, "   ");
   if (bp == NULL)
      fprintf(stderr, "????");

   else {
         if (arg[0].dword == D_Proc)
            putstr(stderr, &(bp->pname));
         else
            outimage(stderr, arg, 0);
         arg++;
         putc('(', stderr);
         while (nargs--) {
            outimage(stderr, arg++, 0);
            if (nargs)
               putc(',', stderr);
            }
         putc(')', stderr);
      }
	 
   if (pline != 0)
      fprintf(stderr, " from line %d in %s", pline, pfile);
   putc('\n', stderr);
   fflush(stderr);
   }
#endif 					/* TraceBack */

/*
 * Service routine to display variables in given number of
 *  procedure calls to file f.
 */

novalue xdisp(fp,dp,count,f)
   int count;
   FILE *f;
   struct pf_marker *fp;
   register dptr dp;
   {
   register dptr np;
   register int n;
   struct b_proc *bp;
   extern dptr globals, eglobals;
   extern dptr gnames;
   extern dptr statics;

   while (count--) {		/* go back through 'count' frames */
      if (fp == NULL)
         break;       /* needed because &level is wrong in coexpressions */

      bp = (struct b_proc *)BlkLoc(*dp); /* get address of procedure block */

      /*
       * Print procedure name.
       */
      putstr(f, &(bp->pname));
      fprintf(f, " local identifiers:\n");

      /*
       * Print arguments.
       */
      np = bp->lnames;
      for (n = abs(bp->nparam); n > 0; n--) {
         fprintf(f, "   ");
         putstr(f, np);
         fprintf(f, " = ");
         outimage(f, ++dp, 0);
         putc('\n', f);
         np++;
         }

      /*
       * Print locals.
       */
      dp = &fp->pf_locals[0];
      for (n = (int)bp->ndynam; n > 0; n--) {
         fprintf(f, "   ");
         putstr(f, np);
         fprintf(f, " = ");
         outimage(f, dp++, 0);
         putc('\n', f);
         np++;
         }

      /*
       * Print statics.
       */
      dp = &statics[bp->fstatic];
      for (n = (int)bp->nstatic; n > 0; n--) {
         fprintf(f, "   ");
         putstr(f, np);
         fprintf(f, " = ");
         outimage(f, dp++, 0);
         putc('\n', f);
         np++;
         }

      dp = fp->pf_argp;
      fp = fp->pf_pfp;
      }

   /*
    * Print globals.
    */
   fprintf(f, "\nglobal identifiers:\n");
   dp = globals;
   np = gnames;
   while (dp < eglobals) {
      fprintf(f, "   ");
      putstr(f, np);
      fprintf(f, " = ");
      outimage(f, dp++, 0);
      putc('\n', f);
      np++;
      }
   fflush(f);
   }