/*     
      LABEL LIST MANAGER . Magma 1.0 . 1996 . Sylvain HUET

         gestion de listes de labels pour la compilation
*/
//
// Modifications history:
//$ FA(20/06/2001): Debugger integration. Add support for var id and extra entries
//$ FA(27/10/2001): The initial environment is implemented as a hash table to
//  accelerate package loading
//$ FA(12/11/2001): Replace SCOL_DEBUGGER_AWARE by INCLUDE_DEBUGGER except for
//    Maddvar() which uses the constant RELEASE_DEVELOPER
//
//

#include <stdio.h>
#include <string.h>
#include "mmemory.h"
#include "mbytec.h"
#include "listlab.h"
#include "scol.h"
#include "debug.h"
#include "macros.h"

/* empilement d'une chaine de caracteres */
int Mpushstring(mmachine m,char *name)
{
  int l,s;

  if (name==NULL) return MMpush(m,NIL);
  l=(strlen(name)+4)>>2;
  s=MMmalloc(m,l,TYPEBUF); if (s==NIL) return MERRMEM;
  strcpy((char*)&m->tape[s+SizeHeader],name);
  
  if (MMpush(m,s+s+1)) return MERRMEM;
  return 0;
}

/* empilement d'une chaine de caracteres avec caracteres speciaux
   la chaine commence et finit par des guillemets */
int Mpushstrtok(mmachine m,char *name)
{
  int c,i,l,s,n,sl,k;
  char *p;

  l=strlen(name);
  if ((l<2)||(name[0]!='\"')||(name[l-1]!='\"')) return MERRTYP;
  sl=(l+4)>>2;
  s=MMmalloc(m,sl+1,TYPEBUF); if (s==NIL) return MERRMEM;
  p=(char*)&m->tape[s+SizeHeader+1];

  i=1; n=0;
  while(i<l-1)
    {
      c=name[i++];
      if (c=='\\')
        {
          c=name[i++];
          if (c=='n') c=10;
		  else if (c=='z') c=0;
    	  else if ((c>='0')&&(c<='9'))
	        {
	          k=c-'0';
	          c=name[i];
	          if ((c>='0')&&(c<='9'))
		        {
		          i++;
		          k=(k*10)+c-'0';
		          c=name[i];
		          if ((c>='0')&&(c<='9'))
		            {
		              i++;
		              k=(k*10)+c-'0';
		            }
		        }
	          c=k;
	        }
          else while(c<32) c=name[i++];
        }
      p[n++]=c;
    }
  p[n]=0;
  m->tape[s+SizeHeader]=n;

  if (MMpush(m,s+s+1)) return MERRMEM;
  return 0;
}
  

/* empilement d'une chaine sous forme de bloc */
int Mpushstrbloc(mmachine m,char *buf)
{
  int s,l,sl;
  char *cr;

  if (buf==NULL) return MMpush(m,NIL);
  l=strlen(buf);
  sl=(l+4)>>2;
  s=MMmalloc(m,sl+1,TYPEBUF); if (s==NIL) return MERRMEM;
  m->tape[s+SizeHeader]=l;

  cr=(char*)&m->tape[s+SizeHeader+1];
  strcpy(cr,buf);
  return MMpush(m,s+s+1);
}

/* empilement d'une chaine sous forme de bloc */
int Mpushstrblocn(mmachine m,char *buf,int l)
{
  int s,sl;
  char *cr;

  if (buf==NULL) return MMpush(m,NIL);
  sl=(l+4)>>2;
  s=MMmalloc(m,sl+1,TYPEBUF); if (s==NIL) return MERRMEM;
  m->tape[s+SizeHeader]=l;

  cr=(char*)&m->tape[s+SizeHeader+1];
  memcpy(cr,buf,l);
  cr[l]=0;
  return MMpush(m,s+s+1);
}

/* ajout d'un label dans une liste, avec test d'unicite
la liste first est dans la pile */
int Maddlabel(mmachine m, int first, char *name, int num)
{
  int l,s;

  if (l=Mpushstring(m,name)) return l;

  s=MMmalloc(m,SIZELISTB,TYPETAB); if (s==NIL) return MERRMEM;

  m->tape[s+SizeHeader+OFFLBNAME]=m->top[m->pp];
  m->tape[s+SizeHeader+OFFLBNUM] =num*2;
  m->tape[s+SizeHeader+OFFLBNEXT]=m->top[first];
  m->top[first]=s+s+1;
  m->pp++;

  return 0;
}

/* suppression des n premiers elements de la liste */
int Mdelnlabel(mmachine m, int first, int n)
{
  int i,s;

  for(i=0;i<n;i++)
    {
      s=m->top[first];
      if (s!=NIL)
        {
          s>>=1;
          m->top[first]=m->tape[s+SizeHeader+OFFLBNEXT];
        }
    }
  return 0;
}

/* recherche d'un label dans une liste
   (retourne -1 si introuvable) */
int Msearchlabel(mmachine m, int first, char *name)
{
  int i,s;

  i=first;
  while(i!=NIL)
    {
      i>>=1;
      s=(m->tape[i+SizeHeader+OFFLBNAME]>>1);
      if (!strcmp((char*)&m->tape[s+SizeHeader], name))
        return (m->tape[i+SizeHeader+OFFLBNUM]>>1);
      i=m->tape[i+SizeHeader+OFFLBNEXT];
    }
  return -1;
}

int Mnbvar(mmachine m,int i)
{
  int n=0;

  while(i!=NIL)
    {
      n++;
      i=m->tape[(i>>1)+SizeHeader+OFFVNEXT];
    }
  return n;
}

int Mnthvar(mmachine m,int i,int n)
{
  while((i!=NIL)&&(n))
    {
      n--;
      i=m->tape[(i>>1)+SizeHeader+OFFVNEXT];
    }
  return i;
}


/* ajout d'une variable dans une liste, avec test d'unicite
la liste first est dans la pile */
int Maddvar(mmachine m, int first, char *name,int typ)
{
  int l,s;

  if (Msearchvar(m,m->top[first],name)!=NIL) return MERRTYP;

  if (l=Mpushstring(m,name)) return l;

  s=MMmalloc(m,SIZEVAR,TYPETAB); if (s==NIL) return MERRMEM;

  m->tape[s+SizeHeader+OFFVNAME]=m->top[m->pp];
  m->tape[s+SizeHeader+OFFVVAL] =0;
  m->tape[s+SizeHeader+OFFVTYP] =typ*2;
  m->tape[s+SizeHeader+OFFVSTYP] =NIL;
  m->tape[s+SizeHeader+OFFVNEXT]=m->top[first];
//$ FA(08/11/2000)
  m->tape[s+SizeHeader+OFFVPKG]  = NIL;
#if defined(RELEASE_DEVELOPER)
//$ FA(29/11/2000): Assign unique id to global var object
  m->tape[s+SizeHeader+OFFVID]   = SEI2W(varID++);
//$ FA(20/06/2001): Size and cost initially null
  m->tape[s+SizeHeader+OFFVSIZE] = NIL;
#endif
//
  m->top[first]=s+s+1;
  m->pp++;

  return 0;
}

/* recherche d'une variable dans une liste
   (retourne l'adresse dans la bande, ou NIL si introuvable) */
int Msearchvar(mmachine m, int first, char *name)
{
  int i,s;
  char c = *name;

//  MMechostr(1,"searchvar %d %s\n",first,name);
  i=first;
  while(i!=NIL)
    {
      char* name0;
      i>>=1;
      s=(m->tape[i+SizeHeader+OFFVNAME]>>1);
      name0 = (char*)&m->tape[s+SizeHeader];
      if (c == *name0 && !strcmp(name0, name))
        return i;
      i=m->tape[i+SizeHeader+OFFVNEXT];
    }
  return NIL;
}


/* recherche un package dans une liste */
int Msearchpak(mmachine m, int first, char *name)
{
  int i,j,s;

  i=first;
  while(i!=NIL)
    {
      i>>=1;
      j=(m->tape[i+SizeHeader+OFFLVAL]>>1);
      s=(m->tape[j+SizeHeader+OFFPKNAME]>>1);
      if (!strcmp((char*)&m->tape[s+SizeHeader],name))
        return j;
      i=m->tape[i+SizeHeader+OFFLNEXT];
    }
  return NIL;
}


#if !defined(INCLUDE_DEBUGGER)
//$ FA(27/10/2001): The initial environment is implemented as a hash table to
//  accelerate package loading

#define INITIAL_ENV_SIZE 1000

static uint hashCode(const char* name)
{
  const char* p  = name;
  uint key = 0;

  while (*p++)
    key += *p;

  return key;
}


static int initialEnvAddVAR(mmachine m, SEINT i)
{
  uint bucket;

  bucket = hashCode(SECSTR(m, SEW2P(SEFETCH(m, SEW2P(SEGET(m, i)), OFFVNAME)))) % INITIAL_ENV_SIZE;
  //MMechostr(MSKTRACE, ">>>>> bucket = %d\n", bucket);
  // Allocate hashtable if it was not done before
  if (SEGET(m, i+3) == NIL) {
    SEPTR res;
    int k;

    if ((res = MMmalloc(m, INITIAL_ENV_SIZE, TYPETAB)) < 0)
      return res;
    // Initialise all hashtable entries to nil
    for (k = 0; k < INITIAL_ENV_SIZE; k++)
      SESTORE(m, res, k, NIL);
    //MMechostr(MSKTRACE, ">>>>> hash table allocated; root = %d\n", res);
    SESET(m, i+3, SEP2W(res)); 
  }
  // Add VAR reference into the beginning of the bucket list
  SECHECK(SEPUSH(m, SEGET(m, i)));
  SECHECK(SEPUSH(m, SEFETCH(m, SEW2P(SEGET(m, i+3)), bucket)));
  SECHECK(SEPUSH(m, SEI2W(2)));
  SECHECK(SENEWTUPLE(m));
  //MMechostr(MSKTRACE, ">>>>> hash table entry %d\n", SEW2P(SEGETTOP(m, 0)));
  SESTORE(m, SEW2P(SEGET(m, i+3)), bucket, SEPOP(m));

  return MERROK;
}


int createInitialEnvironment(mmachine m)
// [0] initial environment
{
  SEINT i;

  // Add all functions in the base environment into the hash table
  SECHECK(SEPUSH(m, NIL));            // hash table
  SECHECK(SEPUSH(m, SEGETTOP(m, 1))); // current list node
  SECHECK(SEPUSH(m, NIL));            // current package
  SECHECK(SEPUSH(m, NIL));            // current variable
  i = SEGETSP(m);
  while (SEGET(m, i+2) != NIL) {
    SESET(m, i+1, SEHEAD(m, SEW2P(SEGET(m, i+2))));
    SESET(m, i, SEFETCH(m, SEW2P(SEGET(m, i+1)), OFFPKINTRN));
    //MMechostr(MSKTRACE, "\n[%s]\n", SECSTR(m, SEW2P(SEFETCH(m, SEW2P(SEGET(m, i+1)), OFFPKNAME))));
    while (SEGET(m, i) != NIL) {
      initialEnvAddVAR(m, i);
      //MMechostr(MSKTRACE, "%d:%s\n", SEW2P(SEGET(m, i)), SECSTR(m, SEW2P(SEFETCH(m, SEW2P(SEGET(m, i)), OFFVNAME))));
      SESET(m, i, SEFETCH(m, SEW2P(SEGET(m, i)), OFFVNEXT));
    }
    SESET(m, i+2, SETAIL(m, SEW2P(SEGET(m, i+2))));
  }
  // Overwrite stack top and clean up stack
  SEDROP(m, 3);
  SESWAP(m);
  SEDROP(m, 1);
  return MERROK;
}

/*
void printInitialEnvironment(mmachine m)
// [0] initial environment
{
  int k;

  for (k = 0; k < INITIAL_ENV_SIZE; k++) {
    SEWORD l = SEFETCH(m, SEW2P(SEGETTOP(m, 0)), k);
    MMechostr(MSKTRACE, "\n[bucket %d]\n", k);
    while (l != NIL) {
      SEWORD var = SEHEAD(m, SEW2P(l));
      MMechostr(MSKTRACE, "%s\n", SECSTR(m, SEW2P(SEFETCH(m, SEW2P(var), OFFVNAME))));
      l = SETAIL(m, SEW2P(l));
    }
  }
}
*/
#endif

int Mismagstd(const char *name);


/* recherche une variable dans une liste de packages */
int Msearchinpak(mmachine m, int first, char *name)
{
  int i,j,k;
#if !defined(INCLUDE_DEBUGGER)    //$ FA(26/10/2001)
  SEWORD initialEnvironment = m->top[m->maxpp+OFFSCBASE];
#endif
//  MMechostr(1,"searchinpack %d %s\n",first,name);
  i=first;
  while(i!=NIL)
    {
#if defined(INCLUDE_DEBUGGER)
	    if ((i==m->top[m->maxpp+OFFSCBASE])&&(Mismagstd(name)!=-1)) return NIL;
#else
      if (i == initialEnvironment) {
        SEWORD l = m->tape[SEW2P(initialEnvironment)+SizeHeader+hashCode(name)%INITIAL_ENV_SIZE];
        if (Mismagstd(name) != NIL)
          return NIL;
        while (l != NIL) {
          SEPTR var = SEW2P(m->tape[SEW2P(l)+SizeHeader+OFFLVAL]);
          if (!strcmp(name, SECSTR(m, SEW2P(m->tape[var+SizeHeader+OFFVNAME]))))
            return var; // found
          l = m->tape[SEW2P(l)+SizeHeader+OFFLNEXT];
        }
        return NIL; // not found
      }
#endif
      i>>=1;
      j=(m->tape[i+SizeHeader+OFFLVAL]>>1);
      k=Msearchvar(m,m->tape[j+SizeHeader+OFFPKINTRN],name);
      if (k!=NIL) return k;

      i=m->tape[i+SizeHeader+OFFLNEXT];
    }
  return NIL;
}


/* recherche une variable dans les package systeme */
int Msearchinsyspak(mmachine m, char *name)
{
	int k;
	k=Msearchinpak(m,m->top[m->maxpp+OFFSCBASE],name);
	if (k==NIL) return k;
	return MMfetch(m,k,1);
}

/* recherche d'une variable de type dans une liste
   (retourne l'adresse dans la bande, ou NIL si introuvable) */
int Msearchvartyp(mmachine m, int first, char *name)
{
  int i,s;
  char c = *name;

  i=first;
  while(i!=NIL)
    {
      char* name0;
      i>>=1;
      s=(m->tape[i+SizeHeader+OFFVNAME]>>1);
      name0 = (char*)&m->tape[s+SizeHeader];
      if (c == *name0 && !strcmp(name0, name)
	        && m->tape[i+SizeHeader+OFFVTYP] == TYPTYPE*2)
        return i;
      i=m->tape[i+SizeHeader+OFFVNEXT];
    }
  return NIL;
}

/* recherche une variable de type dans une liste de packages */
int Msearchtypinpak(mmachine m, int first, char *name)
{
  int i,j,k;
#if !defined(INCLUDE_DEBUGGER)    //$ FA(26/10/2001)
  SEWORD initialEnvironment = m->top[m->maxpp+OFFSCBASE];
#endif
  i=first;
  while(i!=NIL)
    {
#if !defined(INCLUDE_DEBUGGER)
      if (i == initialEnvironment) { //$ FA(26/10/2001)
        SEWORD l = m->tape[SEW2P(initialEnvironment)+SizeHeader+hashCode(name)%INITIAL_ENV_SIZE];
        while (l != NIL) {
          SEPTR var = SEW2P(m->tape[SEW2P(l)+SizeHeader+OFFLVAL]);
          if (!strcmp(name, SECSTR(m, SEW2P(m->tape[var+SizeHeader+OFFVNAME])))
            && m->tape[var+SizeHeader+OFFVTYP] == SEI2W(TYPTYPE))
          return var; // found
          l = m->tape[SEW2P(l)+SizeHeader+OFFLNEXT];
        }
        return NIL; // not found
      } // if
#endif
      i>>=1;
      j=(m->tape[i+SizeHeader+OFFLVAL]>>1);
      k=Msearchvartyp(m,m->tape[j+SizeHeader+OFFPKINTRN],name);
      if (k!=NIL) return k;

      i=m->tape[i+SizeHeader+OFFLNEXT];
    }
  return NIL;
}