/*  LOWLEVEL.C:  Debugging, systems interface, etc */

#include "zip.h"

extern int *H, *HORG, *TRORG, *HTOP;
extern int *LORG, *GORG;
extern int *L, *CL, *TR, *G, *TR0, *XC, *L, *G0, *BL, *BG, *G;
extern int BP, IR, *CL0;
extern char *CP;
extern hash[];
extern int T0, INTFLAG, syswords[];
extern jmp_buf jump_env;

FILE *file;

int M0;  /* referenced here but not set */

/*  instruction names for debugging */

char *inst_name[INSTMAX+1] =
{
  "no_op", "pop", "vararg", "poparg", "var", "firstvar", "firstresult",
  "void", "continue", "functor", "lastfunctor", "constant", "enter",
  "return", "savel", "cut", "depart", "call", "disjunct", "fail",
  "provar", "prononvar", "proatom", "proint", "prosucc", "exit", "callx",
  "immed", "endor", "glofirvar", "glovar", "localcut", "voidn",
  "conslist", "lastconslist", "constnil",
  "proarg", "profunctor", "proequal", "proatomic", "firvararg",
  "eval", "pushb", "pushi", "pushv", "result", "add", "sub", "mul", "div",
  "mod", "shr", "shl", "and", "or", "not", "neg", "eq", "ne", "lt",
  "le", "gt", "ge", "initvar"
};

int inst_size[INSTMAX+1] =
{
  0,1,2,1,2,2,2,
  1,2,3,3,2,2,
  2,2,2,3,2,2,1,
  2,2,2,2,1,1,2,
  2,1,2,2,2,2,
  1,1,1,
  1,1,1,1,2,
  3,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2
};

char *tagname[tagint(TAGMAX)+1] =
{
  "int", "flo", "atom", "box", "term", "cons", "link", "und",
  "func", "bloc", "empt", "trmn", "proc", "tabl", "tabr",
  "clau"
};

char *stknam[8] =
{
  "XX", "BP", "BL", "TR", "CP", "CL", "XC", "G "
};


/*  User interrupt trap */

userint()
{
#ifdef PANOS
/* signal facility not available under Panos as yet */
#else
  if (++INTFLAG < 3)  signal(SIGINT,userint);
  else
#endif
    exit(0);
}


/*  write a word in a legible format for debugging */

writeword(w)
  int w;
{
  printf("%4s|%-6d",tagname[tagint(w)],val(w));
}

/*  write a message of string and word for debugging */

display(s,w)
char *s;
int w;
{
  printf("%s ",s);
  writeword(w);
  putchar('\n');
}


/* write a Prolog clause in legible format */

prclause(s,c)
int c;
char *s;
{
  int t;
  {
  t = memoff(c,CLAPROOFF);
  t = memoff(t,PROFUNOFF);
  prdisp(memoff(t,FUNATOFF));
  display(s,val(c));
  }
}


/* write a Prolog term in a legible format for debugging */

prdisp(t)
int t;
{
  char *p;
  int bc,f,a,n,i,r;
  switch(tag(t))
  {
    default:
      writeword(t);
      break;
    case INT:
      printf("%d",val(t));
      break;
    case UNDEF:
      printf("_%d",val(t));
      break;
    case ATOM:
      t = memoff(t,ATOCHOFF);
      /* drop through */
    case BOX:
      bc = blockchars(t);
      p = (char *) (((int *) val(t)) + 1);
      while (bc--) putchar(*p++);
      break;
    case CONS:
      putchar('[');
      r = memoff0(t);
      deref(r);
      prdisp(r);
      putchar('|');
      r = memoff(t,1);
      deref(r);
      prdisp(r);
      putchar(']');
      break;
    case TERM:
      f = termfunctor(t);
      a = memoff(f,FUNATOFF);
      prdisp(a);
      n = memoff(f,FUNAROFF);
      if (n > 0)
      {
        putchar('(');
        for (i=1; i <= n; i++)
        {
          r = memoff(t,i);
          deref(r);
          prdisp(r);
          if (i < n) putchar(',');
        }
        putchar(')');
      }
      break;
  }
}


/* fatal error */

fatality(n)
int n;
{
  printf("fatal error %d\n",n);
  longjmp(jump_env,0);
}


/* processor trap */

processortrap(n)
int n;
{
  T0 = 2;
  printf("PROCESSOR TRAP %d\n",n);
  frontpanel(0);
  options();
}

/* instruction trap */

insttrap(pc)
char *pc;
{
  int i;
  i = (int) *pc;
  printf("[%s ",inst_name[i]);
  if (inst_size[i] > 1) printf("%d",(int) *(pc+1));
  if (inst_size[i] == 3) printf(" %d",(int) *(pc+2));
  printf("]\n");
}


/* dump some resisters to the display */

frontpanel(M0)
int M0;
{
  int g,l,h,t;
  g = 100 * (G - GORG) / GS_SIZE;
  l = 100 * (L - LORG) / LS_SIZE;
  h = 100 * (H - HORG) / H_SIZE;
  t = 100 * (TR - TRORG) / TR_SIZE;
  printf("G = %2d  L = %2d  H = %2d  T = %2d\n",g,l,h,t);
  printf("         M0         XC         TR         CP         BP         BL\n     ");
  writeword((int)M0); writeword((int)XC); writeword((int)TR), writeword((int)0);
  writeword((int)BP); writeword((int)BL);
  printf("\n         BG         CL0        CL         L          TR0        G\n     ");
  writeword((int)0); writeword((int)0); writeword((int)CL); writeword((int)L);
  writeword((int)0); writeword((int)G);
  putchar('\n');
}


/* deal with questions from the floor */

options()
{
  char s[80], c;
  int i, j, k, *p;
  while (TRUE)
  {
  printf("Examine, Heap, List, Trace, Display: ");
  fgets(s,80,stdin);
  c = s[0];
  sscanf(&(s[1]),"%d",&i);
  switch (c)
  {
    case 'd':
      frontpanel(0);
      break;
    case '\n':
      return;
    case 't':
      T0 = i;
      break;
    case 'e':
      writeword(mem(i));
      printf("    ");
      writebytes(mem(i));
      putchar('\n');
      break;
    case 'E':
      prdisp(mem(i));
      putchar('\n');
      break;
    case 'l':
      j = 0;
      while (j < 10)
      {
        if (j < 8) printf("%s  ",stknam[j]); else printf("    ");
        writeword(mem(i));
        printf("    ");
        writebytes(mem(i));
        i = (int) ((int *) i + 1);
        j++;
        putchar('\n');
      }
      break;
    case 'L':
      j = 0;
      while (j < 10)
      {
        if (j < 8) printf("%s  ",stknam[j]); else printf("    ");
        prdisp(mem(i));
        i = (int) ((int *) i + 1);
        j++;
        putchar('\n');
      }
      break;
    case 'h':
      p = H;
      k = 0;
      j = 0;
      while (p != 0)
      {
        j++;
        k += *(p+FRECOUOFF);
   if (p + *(p+FRECOUOFF) == (int *) *(p+FRELINOFF)) display("pair at ",(int) p);
        p = (int *) *(p+FRELINOFF);
      }
      printf("%d cells, and %d words free\n",j,k);
      break;
  }
  }
}


/* Arrival trap */

arrtrap(ms,mv)
char *ms;
int mv;
{
  int f,a,i,r;
  printf("%s ",ms);
  if (tag(mv) == PROC)
  {
    f = memoff(mv,PROFUNOFF);
    a = memoff(f,FUNATOFF);
    prdisp(a);
    putchar('(');
    a = val(memoff(f,FUNAROFF));
    for (i = 1; i <= a; i++)
    {
      r = *(CL+ARGOFF+i);
      deref(r);
      prdisp(r);
      if (i != a) putchar(',');
    }
    putchar(')');
    putchar('\n');
  }
  else
  {
    prdisp(mv);
    putchar('\n');
  }
}


/* ZIP machine debugging */

trace(m,ms,mv,p,w,pc)
int m,mv,p,w;
char *ms;
char *pc;
{
  if (m)
  {
    if (m & TMSIMESS) insttrap(pc);
    else if (m & TMARMESS) arrtrap(ms,mv);
    else display(ms,mv);
  }
  if (p) frontpanel(mv);
  if (w) options();
}


/* read initial heap image */

int relocate(w)
{
  return(makeword(tag(w),(int)(HORG+val(w))));
}

int readheap()
{
  int i, w, k;
#ifdef os370
  if ((file = fopen("sysimage", "r,binary,ddn")) == NULL &&
      (file = fopen("'am21.prologx.zap.out'","r,binary")) == NULL) return(0);
#else
  if ((file = fopen("zap.out","r")) == NULL) return(0);
#endif
  for (i=0; i < LENHASH; i++) hash[i] = relocate(readword());
  for (i=0; i < SYSWSIZE; i++) syswords[i] = relocate(readword());
  H = HORG;
  do
  {
    w = readword();
    if (w != EOF)
    {
      switch(tag(w))
      {
        case BLOCK:
          *H++ = w;
          k = ((val(w) - 1) >> 2) + 1;
          while (k-- > 0) *H++ = readword();
          break;
        case TABLE:
          *H++ = w;
          k = val(w) - 1;
          while (k--)
          {
            i = readword();
            *H++ = (tag(i) == INT) ? i : relocate(i);
          }
          break;
        case INT:
        case EMPTY:
        case TERMIN:
        case CONS:  /* appears in heap only as a key */
          *H++ = w;
          break;
        default:
          *H++ = relocate(w);
      }
      if (H > HTOP)
      {
        printf("heap size exceeded\n");
        exit(0);
      }
    }
  } while (w != EOF);
  *(H+FRELINOFF) = 0;
  *(H+FRECOUOFF) = (int) (TRORG - H);
  return(1);
}


/* read a word from the Heap Image */

int readword()
{
  int c,i;
  c = getc(file);
  if (c == EOF) return(c);
  c &= 0377;
  for (i = 0; i < 3; i++) c = (c << 8) | (getc(file) & 0377);
  return(c);
}


/* write a word in byte form */

writebytes(w)
{
  wbyte((w >> 24) & 0377);
  wbyte((w >> 16) & 0377);
  wbyte((w >>  8) & 0377);
  wbyte(        w & 0377);
}


wbyte(i)
{
  printf("%3d ",i);
  if ((i < '!') || (i > 127)) printf("    "); else printf("(%c) ",i);
}