/* convert.c:  various conversions */
/*  this is the only file that looks at the hash table and name buffer */

#include "zip.h"

extern int *alloc(), *getheap();
extern int syswords[], *modptr;

#define LENNAMEBUF 257   /* header + 1024 characters */
#define LOWNAMEBUF buffname
#define MAXNAMEBUF &buffname[LENNAMEBUF-2]

char *buffindx;
int buffhash, buffname[LENNAMEBUF], hash[LENHASH];


/* construct a block on the global stack from the name buffer, return box */

int makebox()
{
  int *c;
  register int n, *b, *t;
  n = blocksize(val(buffname[0]));
  c = t = alloc(n);
  b = buffname;
  while (n--) *t++ = *b++;
  return(makeword(BOX,(int) c));
}


/* construct an atom of having a box of length n, fill in components, return pointer */

static int makeatom(n)
int n;
{
  register int *t, *b, *c;
  c = t = getheap(n + ATOMLEN);
  b = buffname;
  while (n--) *t++ = *b++;
  *(t+ATOHAOFF) = *(t+ATOFUOFF) = TERMIN;
  *(t+ATOCHOFF) = makeword(BOX,(int) c);
  return(makeword(ATOM,(int) t));
}


/*
  Initialise the Name Buffer, hash accumulator, and current pointer.
*/

initbuff()
{
  buffhash = 0;
  buffindx = (char *) &buffname[1];
}


/* return the atom having the name matching the buffname */

int findatom()
{
  register int *i, *j, m, s;
  int p, n;
  n = blocksize(val(buffname[0]));
  if (tag(hash[buffhash]) == TERMIN)  return(hash[buffhash] = makeatom(n));
  else
  {
    p = val(hash[buffhash]);
    while (TRUE)
    {
      i = (int *) val(mem(p+ATOCHOFF));
      j = &buffname[0];
      m = n;
      s = TRUE;
      while (s && m--) if (*i++ != *j++) s = FALSE;
      if (s) return(makeword(ATOM,p));
      else if (tag(mem(p+ATOHAOFF)) == TERMIN) return(mem(p+ATOHAOFF) = makeatom(n));
      else p = val(mem(p+ATOHAOFF));
    }
  }
}


/*
  Accumulate characters into a buffer, accumulating a hash value.
  The hash function s <- (5 * s) xor a.
*/

int keepchar(c)
char c;
{
  if (buffindx > (char *) MAXNAMEBUF) return(FALSE);
  *buffindx++ = c;
  buffhash = (buffhash * 5) ^ c;
  return(TRUE);
}


/*  convert the buffer into a block lookalike */

makeblock()
{
  int bc;
  bc = (int) (buffindx - ((char *) (&buffname[1])));
  buffname[0] = makeword(BLOCK,bc);
  *buffindx++ = '\0';
  *buffindx++ = '\0';
  *buffindx++ = '\0';
  if (buffhash < 0)  buffhash = -buffhash;
  buffhash %= LENHASH;
}


/* convert a list to an integer, and return it.  Return tag UNDEF if not int */
/* used only by name(X,Y) */

int cvtlisint(t)
int t;
{
  int n,c;
  n = 0;
  while (t != syswords[SWNIL])
  {
    if (tag(t) != CONS) return(UNDEF);
    c = val(memoff0(t)) - convch('0');
    if (c < 0 || c > 9) return(UNDEF);
    n = (10 * n) + (c - 0);
    t = memoff(t,1);
  }
  return(makeword(INT,n));
}


/* convert a list into a box. */
/* used by name and primcom3 */

char cvtlisbox(t)
int t;
{
  initbuff();
  while (t != syswords[SWNIL])
  {
    if (tag(t) != CONS) return(FALSE);
    if (!keepchar(memoff0(t) & BYTEMASK)) return(FALSE);
    t = memoff(t,1);
  }
  makeblock();
  return(TRUE);
}


/* convert an integer to a list of its character codes */
/* used only by name(X,Y) */

int cvtintlis(i)
int i;
{
  char a[20], n;
  int p,t;
  int *k;
  n = FALSE;
  p = 0;
  i = val(i);
  i = signextend(i);
  if (i < 0)
  {
    n = TRUE;
    i = -i;
  }
  do { a[p++] = convch('0') + (i % 10); } while (i /= 10);
  if (n) a[p] = convch('-'); else --p;
  k = alloc(2 * (p + 1));
  t = (int) k;
  while (p >= 0)
  {
    *k++ = makeword(INT, a[p--]);
    *k = makeword(CONS,(int) (k+1));
    k++;
  }
  *(k-1) = syswords[SWNIL];
  return(makeword(CONS,t));
}


/* convert a box to a list */
/* used only by name(X,Y) */

int cvtboxlis(b)
int b;
{
  char *bp;
  int i, *k, t;
  i = blockchars(b);
  k = alloc(2 * i);
  t = (int) k;
  bp = (char *) (((int *) val(b)) + 1);
  while (i--)
  {
    *k++ = makeword(INT,*bp++);
    *k = makeword(CONS,(int) (k+1));
    k++;
  }
  *(k-1) = syswords[SWNIL];
  return(makeword(CONS,t));
}


/* construct the functor of atom a and arity i */

static int makefunct(a,i)
int a, i;
{
  int *h;
  h = getheap(FUNCLEN);
  *(h+FUNATOFF) = a;
  *(h+FUNAROFF) = makeword(INT,i);
  *(h+FUNFUOFF) = *(h+FUNPROFF) = TERMIN;
  return(makeword(FUNCTOR,(int) h));
}


/* search for a functor, creating one if necessary and required */

int findfunct(a,i,need)
int a, i, need;
{
  int p;
  proctrap((tag(a) != ATOM),43);
  p = memoff(a,ATOFUOFF);
  if (tag(p) == TERMIN)
    return ((need) ? (memoff(a,ATOFUOFF) = makefunct(a,i)) : TERMIN);
  p = val(p);
  while (TRUE)
  {
    if (i == val(mem(p+FUNAROFF))) return(makeword(FUNCTOR,p));
    else if (tag(mem(p+FUNFUOFF)) == TERMIN)
      return ((need) ? (mem(p+FUNFUOFF) = makefunct(a,i)) : TERMIN);
    p = val(mem(p+FUNFUOFF));
  }
}


/* construct a procedure (including fixture) in the current module */

static int makeproc(m,f)
int m,f;
{
  int *a, *t;
  a = getheap(PROCLEN+FIXTURELEN);
  *(a+PRODEFOFF) = *(a+PROVISOFF) = m;
  *(a+PROFUNOFF) = f;
  *(a+PROFLAOFF) = makeword(INT,0);
  *(a+PROPROOFF) = TERMIN;
  t = a + PROCLEN;
  *(a+PROCLAOFF) = makeword(TABREF,(int) t);
  *(t+FIXTABOFF) = makeword(TABLE,FIXTURELEN);
  *(t+FIXFIROFF) = *(t+FIXLASOFF) = TERMIN;
  return(makeword(PROC,(int) a));
}


/*  search for a procedure, constructing if required */

int findproc(f,m,need)
int f, m, need;
{
  int p;
  proctrap((tag(f) != FUNCTOR),44);
  p = memoff(f,FUNPROFF);
  if (tag(p) == TERMIN)
    return ((need) ? (memoff(f,FUNPROFF) = makeproc(m,f)) : TERMIN);
  p = val(p);
  while (TRUE)
  {
    if ((m == mem(p+PROVISOFF)) || (mem(p+PROFLAOFF) & PFOMNI))
      return(makeword(PROC,p));
    else if (tag(mem(p+PROPROOFF)) == TERMIN)
      return ((need) ? (mem(p+PROPROOFF) = makeproc(m,f)) : TERMIN);
    p = val(mem(p+PROPROOFF));
  }
}


/*
  Given a functor and a module name where the functor is supposedly
  defined, import the fuctor into the current module.  Return an
  error code, which is 0 for no error.
*/

int improc(f,a)
int f, a;
{
  int flags, *h, p;
  p = memoff(f,FUNPROFF);
  if (tag(p) != PROC) return(59);
  p = val(p);
  while (TRUE)
  {
    if (a == mem(p+PRODEFOFF))
    {
      if (mem(p+PROVISOFF) == *modptr) return(61);
      flags = val(mem(p+PROFLAOFF));
      if (flags & PFOMNI) return(60);
      if ((flags & PFVISA) == 0) return(62);
      h = getheap(PROCLEN);
      *(h+PRODEFOFF) = a;
      *(h+PROVISOFF) = *modptr;
      *(h+PROFLAOFF) = makeword(INT,flags);
      *(h+PROFUNOFF) = f;
      *(h+PROCLAOFF) = mem(p+PROCLAOFF);
      f = val(f);
      *(h+PROPROOFF) = mem(f+FUNPROFF);
      mem(f+FUNPROFF) = makeword(PROC,(int)h);
      return(0);
    }
    else if (tag(mem(p+PROPROOFF)) == TERMIN) return(59);
    else p = val(mem(p+PROPROOFF));
  }
}