/*     
      TYPE CHECKER . Magma 1.0 . 1996 . Sylvain HUET

         typcheck.cpp : routine de type-checking
*/
//$ FA(03/05/2001): Promote to C++ file
//$ FA(03/05/2001): Use new lexer interface (lexer.h)
//$ FA(20/06/2001): Debugger integration. Add support for extra var fields
//$ FA(17/07/2001): Replace MAXSIZETOKEN by MAXSIZETOKEN+1 in buffer definitions
//$ FA(12/11/2001): Replace SCOL_DEBUGGER_AWARE by RELEASE_DEVELOPER
//$ BB(11/03/2010): Add manlyz in several functions to add error message in manlyz structure buffer

#include <stdio.h>
#include <string.h>
#include "debug.h"
#include "compiler/lexer.h"
#include "loadpak.h"
#include "scolMacros.h"
extern "C" {
#include "scolMMemory.h"
#include "vm/mbytec.h"
#include "mbytec2.h"
#include "listlab.h"
#include "compiler/typmisc.h"
}

int TCreadp(mmachine m,manlyz z,int ind);
int TCreadvt(mmachine m,manlyz z,int ind);

/* finit l'integration d'une variable ou d'une fonction
  0:noeud 1:nom
-> rien */
int TCendget(mmachine m,manlyz z,int ind,int val,int n)
{
  int k,s,i;
  char *name,*typ,*typ2;

  name=(char*)&m->tape[(m->top[m->pp+1]>>1)+SizeHeader];

  i=Msearchvar(m,m->top[ind+PKGVAR],name);
  if ((i!=NIL)&&(m->tape[i+SizeHeader+OFFVVAL]!=NIL))
  {
	  sprintf(z->mess,">>> ERROR - check(00): '%s' redefinition error <<<",name);
      return MERRTYP;
  }
  if (i==NIL)
  {
	  i=Msearchinpak(m,m->top[ind+PKGLP],name);
    //$BB global var don't need to be unique in Environment ?
    //kept for backware compatibility
      if (m->tape[i+SizeHeader+OFFVTYP]==TYPVAR*2) i=NIL;
  }
  
  if ((i!=NIL)&&(m->tape[i+SizeHeader+OFFVVAL]==NIL))
  {
    if (val==NIL)
    {
      sprintf(z->mess,">>> ERROR - check(01): '%s' prototype's redefinition error <<<",name);
      return MERRTYP;
    }

	  if (m->tape[i+SizeHeader+OFFVTYP]!=n*2)
    {
	  		sprintf(z->mess,">>> ERROR - check(02): '%s' redefinition error <<<",name);
        return MERRTYP;
    }

    // on test we keep current value
    // important for proto reference
    if(!z->lex.getTestMode())
    {
      if (n>=0) val-=2;
      m->tape[i+SizeHeader+OFFVVAL]=val;
    }

    if (m->tape[i+SizeHeader+OFFVTYP]==TYPVAR*2)
	  {
		  if (MMpush(m,m->tape[i+SizeHeader+OFFVSTYP])) return MERRMEM;
          if (k=TPtypgraph(m)) return k;
          if (k=TPunif(m,z,m->top[m->pp],m->top[m->pp+1])) return k;
          m->pp+=3;
		  return 0;
	  }

    if (MMpush(m,m->tape[i+SizeHeader+OFFVSTYP])) return MERRMEM;
	  if (MMpush(m,m->top[m->pp])) return MERRMEM;

    if (k=TPtypgraph(m)) return k;
    if (k=TPunif(m,z,m->top[m->pp],m->top[m->pp+2])) return k;
	  if (k=TPsolvenode(m)) return k;

    name=(char*)&m->tape[(m->top[m->pp+3]>>1)+SizeHeader];
    typ=(char*)&m->tape[(m->top[m->pp+1]>>1)+SizeHeader];
    typ2=(char*)&m->tape[(m->top[m->pp]>>1)+SizeHeader];

	  if (strcmp(typ,typ2))
	  {
		  sprintf(z->mess,">>> ERROR - check(03): '%s':\nFound: Proto    %s\nExpected: Proto %s\n<<<\n",name,typ2,typ);
		  return MERRTYP;
	  }
	  m->pp+=4;
      
	  return 0;
  }

  if (k=TPsolvenode(m)) return k;
  name=(char*)&m->tape[(m->top[m->pp+1]>>1)+SizeHeader];
  typ=(char*)&m->tape[(m->top[m->pp]>>1)+SizeHeader];

  if (n==-1) MMechostr(MSKTRACE,"var %s : %s\n",name,typ);
  else MMechostr(MSKTRACE,"fun %s : %s\n",name,typ);

  if (k=TPcheckfun(m))
  {
    sprintf(z->mess,">>> ERROR - check(04): Invalid type <<<");
    return k;
  }

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

  m->tape[s+SizeHeader+OFFVNAME]=m->top[m->pp+1];
  m->tape[s+SizeHeader+OFFVVAL] =val;
  m->tape[s+SizeHeader+OFFVTYP] =n*2;
  m->tape[s+SizeHeader+OFFVSTYP]=m->top[m->pp];
  m->tape[s+SizeHeader+OFFVNEXT]=m->top[ind+PKGVAR];
//$ 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[ind+PKGVAR]=s+s+1;
  m->pp+=2;
  return 0;
}

int TCgetloc(mmachine m, manlyz z, int ind)
{
  int k,nloc;
  char buf[MAXSIZETOKEN+1];

  nloc=0;
  do
    {
      if (Mreadtok(z)) return MERRTYP;
      if (!z->lex.current().is(Token::kIdent))
      {
        if ((nloc==0)&&(z->tok[0]==')')) return 0;
        sprintf(z->mess,"5) variable expected");
        return MERRTYP;
      }

      sprintf(buf,"l%s",z->tok);
      if (TPsearchtype(m,m->top[ind+PKGLOC],buf)!=NIL) return MERRTYP;
      k=TPaddlabel(m,ind+PKGLOC,buf);
      if (k<0) return k;
      if (MMpush(m,k)) return MERRMEM;
      nloc++;
      
      if (Mreadtok(z)) return MERRTYP;
      if ((z->tok[0]!=',')&&(z->tok[0]!=')'))
      {
        sprintf(z->mess,"6) , or ) expected");
        return MERRTYP;
      }
    }
  while(z->tok[0]!=')');

  return nloc;
}

/* verification de type d'une fonction (le nom est deja lu) */
int TCgetfun(mmachine m, manlyz z,int ind)
{
  int k,s,f;
  int nloc,narg;

//MMechostr(0,"> TCgetfun\n");

  m->top[ind+PKGLOC]=NIL;

  if (MMpush(m,NIL)) return MERRMEM;
  if (Mpushstring(m,"#fun")) return MERRMEM;

  if (MMpush(m,NIL)) return MERRMEM;
  if (Mpushstring(m,"#tup")) return MERRMEM;

  if ((Mreadtok(z))||(z->tok[0]!='(')) /* liste des arguments */
  {
    sprintf(z->mess,"7) (arguments) expected");
    return MERRTYP;
  }
  
  //$BLG Note: Retrieving parameters
  narg=nloc=TCgetloc(m,z,ind);
  if (nloc<0) return nloc;
  if (MMpush(m,(nloc+SIZETYP)*2)) return MERRMEM;
  if (k=MBdeftab(m)) return k;
  //Done

  if ((Mreadtok(z))||(z->tok[0]!='=')) /* debut fonction */
  {
    sprintf(z->mess,"8) = expected, found %s",z->tok);
    return MERRTYP;
  }

  k=TPaddlabel(m,ind+PKGLOC,"@");
  if (k<0) return k;
  if (MMpush(m,k)) return MERRMEM;

  if (MMpush(m,(2+SIZETYP)*2)) return MERRMEM;
  if (k=MBdeftab(m)) return k;

  if (k=TCreadp(m,z,ind)) return k;
  if ((Mreadtok(z))||(strcmp(z->tok,";;")))
  {
    sprintf(z->mess,"9) ;; expected");
    return MERRTYP;
  }

  s=MMpull(m);
  f=m->top[m->pp];
  if (k=TPunif(m,z,s,m->tape[(f>>1)+SizeHeader+SIZETYP+1])) return k;

//MMechostr(0,"< TCgetfun\n");

  return TCendget(m,z,ind,Mnbvar(m,m->top[ind+PKGVAR])*2+2,narg);
}

/* verification de type d'une variable (le nom est deja lu) */
int TCgetvar(mmachine m, manlyz z,int ind)
{
  int k;

  m->top[ind+PKGLOC]=NIL;
  if ((Mreadtok(z))||(z->tok[0]!='=')) /* debut fonction */
  {
    sprintf(z->mess,"10) = expected, found %s",z->tok);
    return MERRTYP;
  }

  if (Mreadtok(z))
  {
    sprintf(z->mess,"11) missing element");
    return MERRTYP;
  }

  if (k=TCreadvt(m,z,ind)) return k;

  if ((Mreadtok(z))||(strcmp(z->tok,";;")))
  {
    sprintf(z->mess,"12) ;; expected");
    return MERRTYP;
  }

  return TCendget(m,z,ind,0,-1);
}

int TCgettypeof(mmachine m, manlyz z,int ind)
{
  int k;

  m->top[ind+PKGLOC]=NIL;
  if ((Mreadtok(z))||(z->tok[0]!='='))
  {
    sprintf(z->mess,"13) = expected, found %s",z->tok);
    return MERRTYP;
  }

  if (k=TPtypgraphanlzmono(m,z,ind))
  {
    sprintf(z->mess,"14) invalid type");
    return k;
  }

  if ((Mreadtok(z))||(strcmp(z->tok,";;")))
  {
    sprintf(z->mess,"15) ;; expected");
    return MERRTYP;
  }

  return TCendget(m,z,ind,NIL,-1);
}

int TCgetproto(mmachine m, manlyz z,int ind)
{
  int k,n;

  m->top[ind+PKGLOC]=NIL;
  if ((Mreadtok(z))||(z->tok[0]!='='))
  {
    sprintf(z->mess,">>> ERROR - proto: '=' expected, found '%s' <<<",z->tok);
    return MERRTYP;
  }

  if (k=TPtypgraphanlz(m,z,ind))
  {
    sprintf(z->mess,">>> ERROR - proto: Invalid or missing type <<<"); // Old: Invalid type
    return k;
  }

  if ((Mreadtok(z))||(strcmp(z->tok,";;")))
  {
    sprintf(z->mess,">>> ERROR - proto: ';;' expected <<<");
    return MERRTYP;
  }

  n=TPnbarg(m,m->top[m->pp]);
  if (n==-1)
  {
    sprintf(z->mess,">>> ERROR - proto: Function type expected <<<");
    return MERRTYP;
  }

  return TCendget(m,z,ind,NIL,n);
}

int TCgettypedef(mmachine m, manlyz z,int ind)
{
  int i,k,n,s;
  char *name,*big,*typ;

  m->top[ind+PKGLOC]=NIL;

  i=Msearchvartyp(m,m->top[ind+PKGVAR],z->tok);

  if (i==NIL)
    i=Msearchtypinpak(m,m->top[ind+PKGLP],z->tok);

  if (i!=NIL)
  {
    n=m->tape[i+SizeHeader+OFFVTYP]>>1;
    if ((n==TYPTYPE)&&(m->tape[i+SizeHeader+OFFVVAL]==NIL))
    {
      sprintf(z->mess,"20) type '%s' already defined",z->tok);
      return MERRTYP;
    }
  }

  if (Mreadtok(z))
  {
    sprintf(z->mess,"21) = or ;; expected");
    return MERRTYP;
  }

  if (!strcmp(z->tok,"="))
  { 
    n=0;
    do
      {
        if (Mreadtok(z))
        {
          sprintf(z->mess,"22) name of constructor expected");
          return MERRTYP;
        }
        if (Msearchvar(m,m->top[ind+PKGVAR],z->tok)!=NIL)
        {
          sprintf(z->mess,"23) '%s' already defined error",z->tok);
          return MERRTYP;
        }
        if (Mpushstring(m,z->tok)) return MERRMEM;

        if (Mreadtok(z))
        {
          sprintf(z->mess,"24) missing element\n");
          return MERRTYP;
        }
        z->giveback=1;
        if ((!strcmp(z->tok,"|"))||(!strcmp(z->tok,";;")))
        {
          big=(char*)&m->tape[(m->top[m->pp+1]>>1)+SizeHeader];
          name=(char*)&m->tape[(m->top[m->pp]>>1)+SizeHeader];
          MMechostr(MSKTRACE,"%s : fun [] %s\n",name,big);

          sprintf(MMbuf,"fun [] %s",big);
          if (Mpushstring(m,MMbuf)) return MERRMEM;
      
          s=MMmalloc(m,SIZEVAR,TYPETAB); if (s==NIL) return MERRMEM;
      
          m->tape[s+SizeHeader+OFFVNAME]=m->top[m->pp+1];
          m->tape[s+SizeHeader+OFFVVAL] =n*2;
          m->tape[s+SizeHeader+OFFVTYP] =TYPCONS0*2;
          m->tape[s+SizeHeader+OFFVSTYP]=m->top[m->pp];
          m->tape[s+SizeHeader+OFFVNEXT]=m->top[ind+PKGVAR];
//$ 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[ind+PKGVAR]=s+s+1;
          m->pp+=2;
          n++;
        }
        else
        {
          if (k=TPtypgraphanlzmono(m,z,ind))
            {
              sprintf(z->mess,"25) invalid type");
              return k;
            }
          if (k=TPsolvenode(m)) return k;
          
          big=(char*)&m->tape[(m->top[m->pp+2]>>1)+SizeHeader];
          name=(char*)&m->tape[(m->top[m->pp+1]>>1)+SizeHeader];
          typ=(char*)&m->tape[(m->top[m->pp]>>1)+SizeHeader];
          MMechostr(MSKTRACE,"%s : fun [%s] %s\n",name,typ,big);
          
          sprintf(MMbuf,"fun [%s] %s",typ,big);
          if (Mpushstring(m,MMbuf)) return MERRMEM;
          
          s=MMmalloc(m,SIZEVAR,TYPETAB); if (s==NIL) return MERRMEM;
          
          m->tape[s+SizeHeader+OFFVNAME]=m->top[m->pp+2];
          m->tape[s+SizeHeader+OFFVVAL] =n*2;
          m->tape[s+SizeHeader+OFFVTYP] =TYPCONS*2;
          m->tape[s+SizeHeader+OFFVSTYP]=m->top[m->pp];
          m->tape[s+SizeHeader+OFFVNEXT]=m->top[ind+PKGVAR];
//$ 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[ind+PKGVAR]=s+s+1;
          m->pp+=3;
          n++;
        }
        if ((Mreadtok(z))||((strcmp(z->tok,";;"))&&(strcmp(z->tok,"|"))))
        {
          sprintf(z->mess,"26) ;; or | expected");
          return MERRTYP;
        }
      }
    while(strcmp(z->tok,";;"));
  }
  else if (strcmp(z->tok,";;"))
  {
    sprintf(z->mess,"27) = or ;; expected");
    return MERRTYP;
  }
  
  big=(char*)&m->tape[(m->top[m->pp]>>1)+SizeHeader];
  i=Msearchvartyp(m,m->top[ind+PKGVAR],big);
  if (i==NIL)
    i=Msearchtypinpak(m,m->top[ind+PKGLP],big);
  if (i!=NIL)
  {
    MMechostr(MSKTRACE,"no more weak : %s\n",big);
    n=m->tape[i+SizeHeader+OFFVTYP]>>1;
    if (n==TYPTYPE) m->tape[i+SizeHeader+OFFVVAL]=NIL;
    m->pp++;
    return 0;
  }
  MMechostr(MSKTRACE,"new type : %s\n",big);

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

  m->tape[s+SizeHeader+OFFVNAME]=m->top[m->pp];
  m->tape[s+SizeHeader+OFFVVAL] =NIL;
  m->tape[s+SizeHeader+OFFVTYP] =TYPTYPE*2;
  m->tape[s+SizeHeader+OFFVSTYP]=NIL;
  m->tape[s+SizeHeader+OFFVNEXT]=m->top[ind+PKGVAR];
//$ 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[ind+PKGVAR]=s+s+1;
  m->pp++;
  
  return 0;
}

int TCgetstruct(mmachine m, manlyz z,int ind)
{
  int i,k,n,s;
  char *name,*big,*typ;
  char bufc[MAXSIZEBUF];

  m->top[ind+PKGLOC]=NIL;
  i=Msearchvartyp(m,m->top[ind+PKGVAR],z->tok);
  if (i==NIL)
    i=Msearchtypinpak(m,m->top[ind+PKGLP],z->tok);

  if (i!=NIL)
  {
    n=m->tape[i+SizeHeader+OFFVTYP]>>1;
    if ((n==TYPTYPE)&&(m->tape[i+SizeHeader+OFFVVAL]==NIL))
    {
      sprintf(z->mess,"28) type '%s' already defined",z->tok);
      return MERRTYP;
    }
  }

  if ((Mreadtok(z))||(strcmp(z->tok,"=")))
  {
    sprintf(z->mess,"29) = expected");
    return MERRTYP;
  }
  if ((Mreadtok(z))||(strcmp(z->tok,"[")))
  {
    sprintf(z->mess,"30) [ expected");
    return MERRTYP;
  }
  n=0;
  strcpy(bufc,"fun[[");

  do
    {
      if (Mreadtok(z))
      {
        sprintf(z->mess,"31) name of field expected");
        return MERRTYP;
      }
      if (Msearchvar(m,m->top[ind+PKGVAR],z->tok)!=NIL)
      {
        sprintf(z->mess,"32) '%s' already defined error",z->tok);
        return MERRTYP;
      }
      if (Mpushstring(m,z->tok)) return MERRMEM;
      if ((Mreadtok(z))||(strcmp(z->tok,":")))
      {
        sprintf(z->mess,"33) : expected");
        return MERRTYP;
      }
          
      if (k=TPtypgraphanlzmono(m,z,ind))
      {
        sprintf(z->mess,"34) invalid type");
        return k;
      }
      if (k=TPsolvenode(m)) return k;
      
      big=(char*)&m->tape[(m->top[m->pp+2]>>1)+SizeHeader];
      name=(char*)&m->tape[(m->top[m->pp+1]>>1)+SizeHeader];
      typ=(char*)&m->tape[(m->top[m->pp]>>1)+SizeHeader];
      MMechostr(MSKTRACE,"%s : fun [%s] %s\n",name,big,typ);
      strcat(bufc,typ);
      strcat(bufc," ");
      sprintf(MMbuf,"fun [%s] %s",big,typ);
      if (Mpushstring(m,MMbuf)) return MERRMEM;
          
      s=MMmalloc(m,SIZEVAR,TYPETAB); if (s==NIL) return MERRMEM;
          
      m->tape[s+SizeHeader+OFFVNAME]=m->top[m->pp+2];
      m->tape[s+SizeHeader+OFFVVAL] =n*2;
      m->tape[s+SizeHeader+OFFVTYP] =TYPFIELD*2;
      m->tape[s+SizeHeader+OFFVSTYP]=m->top[m->pp];
      m->tape[s+SizeHeader+OFFVNEXT]=m->top[ind+PKGVAR];
//$ 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[ind+PKGVAR]=s+s+1;
      m->pp+=3;
      n++;
      if ((Mreadtok(z))||((strcmp(z->tok,"]"))&&(strcmp(z->tok,","))))
      {
        sprintf(z->mess,"35) ] or , expected");
        return MERRTYP;
      }
    }
  while(strcmp(z->tok,"]"));

  big=(char*)&m->tape[(m->top[m->pp]>>1)+SizeHeader];
  strcat(bufc,"]] ");
  strcat(bufc,big);
  if ((Mreadtok(z))||(!z->lex.current().is(Token::kIdent)))
  {
    sprintf(z->mess,"36) name of constructor expected");
    return MERRTYP;
  }
  MMechostr(MSKTRACE,"%s : %s\n",z->tok,bufc);
  if (Msearchvar(m,m->top[ind+PKGVAR],z->tok)!=NIL)
  {
    sprintf(z->mess,"37) '%s' already defined error",z->tok);
    return MERRTYP;
  }
  if (Mpushstring(m,z->tok)) return MERRMEM;
  if (Mpushstring(m,bufc)) return MERRMEM;
  s=MMmalloc(m,SIZEVAR,TYPETAB); if (s==NIL) return MERRMEM;
  
  m->tape[s+SizeHeader+OFFVNAME]=m->top[m->pp+1];
  m->tape[s+SizeHeader+OFFVVAL] =NIL;
  m->tape[s+SizeHeader+OFFVTYP] =TYPSTRUC*2;
  m->tape[s+SizeHeader+OFFVSTYP]=m->top[m->pp];
  m->tape[s+SizeHeader+OFFVNEXT]=m->top[ind+PKGVAR];
//$ 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[ind+PKGVAR]=s+s+1;
  m->pp+=2;

  big=(char*)&m->tape[(m->top[m->pp]>>1)+SizeHeader];
  i=Msearchvartyp(m,m->top[ind+PKGVAR],big);
  if (i==NIL)
    i=Msearchtypinpak(m,m->top[ind+PKGLP],big);
  if (i!=NIL)
  {
    MMechostr(MSKTRACE,"no more weak : %s\n",big);
    n=m->tape[i+SizeHeader+OFFVTYP]>>1;
    if (n==TYPTYPE) m->tape[i+SizeHeader+OFFVVAL]=NIL;
    m->pp++;
  }
  else
  {
    MMechostr(MSKTRACE,"new type : %s\n",big);

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

    m->tape[s+SizeHeader+OFFVNAME]=m->top[m->pp];
    m->tape[s+SizeHeader+OFFVVAL] =NIL;
    m->tape[s+SizeHeader+OFFVTYP] =TYPTYPE*2;
    m->tape[s+SizeHeader+OFFVSTYP]=NIL;
    m->tape[s+SizeHeader+OFFVNEXT]=m->top[ind+PKGVAR];
//$ 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[ind+PKGVAR]=s+s+1;
    m->pp++;
  }
  if ((Mreadtok(z))||(strcmp(z->tok,";;")))
  {
    sprintf(z->mess,"38) ;; expected");
    return MERRTYP;
  }
  
  return 0;
}


int TCgetdefcom(mmachine m, manlyz z,int ind)
{
  int s;
  char chtyp[MAXSIZETOKEN+1];
  char chval[MAXSIZETOKEN+1];
  char *big;


  if (Msearchvar(m, m->top[ind+PKGVAR], z->tok) != NIL)
  {
    sprintf(z->mess,"39) '%s' already defined error", z->tok);
    return MERRTYP;
  }
  
  m->top[ind+PKGLOC] = NIL;
  if ((Mreadtok(z)) || (z->tok[0] != '='))
  {
    sprintf(z->mess, "40) = expected, found %s", z->tok);
    return MERRTYP;
  }
    
  if ((Mreadtok(z)) || (!z->lex.current().is(Token::kIdent)))
  {
    sprintf(z->mess, "41) name of command expected");
    return MERRTYP;
  }
  
  sprintf(chval, "%s", z->tok);
  strcpy(chtyp, "fun[[");

	//MMechostr(0, "TCgetdefcom %s\n", chval);

  do
  {
    if (Mreadtok(z))
    {
      sprintf(z->mess, "42) I or S or ;; expected");
      return MERRTYP;
    }
    if ((!strcmp(z->tok, "I")) || (!strcmp(z->tok, "S")))
    {
      sprintf(chval, "%s %s", chval, z->tok);
      sprintf(chtyp, "%s %s", chtyp, z->tok);
    }
    else if (strcmp(z->tok, ";;"))
    {
      sprintf(z->mess, "43) I or S or ;; expected");
      return MERRTYP;
    }
  } while(strcmp(z->tok, ";;"));
  
  strcat(chtyp, "]] Comm");
  big = (char*)&m->tape[(m->top[m->pp]>>1)+SizeHeader];
  //MMechostr(MSKTRACE, "%s : %s (%s)\n", big, chtyp, chval);

  if (Mpushstring(m, chval)) return MERRMEM;
  if (Mpushstring(m, chtyp)) return MERRMEM;

  s = MMmalloc(m, SIZEVAR, TYPETAB); if (s == NIL) return MERRMEM;
  
  m->tape[s+SizeHeader+OFFVNAME] = m->top[m->pp+2];
  m->tape[s+SizeHeader+OFFVVAL]  = m->top[m->pp+1];
  m->tape[s+SizeHeader+OFFVTYP]  = TYPCOM*2;
  m->tape[s+SizeHeader+OFFVSTYP] = m->top[m->pp];
  m->tape[s+SizeHeader+OFFVNEXT] = m->top[ind+PKGVAR];
//$ 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[ind+PKGVAR] = s+s+1;
  m->pp += 3;

  return 0;
}


int TCgetdefcomvar(mmachine m, manlyz z,int ind)
{
  int s;
  char chtyp[MAXSIZETOKEN+1];
  char chval[MAXSIZETOKEN+1];
  char *big;

  if (Msearchvar(m,m->top[ind+PKGVAR],z->tok)!=NIL)
    {
      sprintf(z->mess,"44) '%s' already defined error",z->tok);
      return MERRTYP;
    }
  m->top[ind+PKGLOC]=NIL;
  if ((Mreadtok(z))||(z->tok[0]!='='))
    {
      sprintf(z->mess,"45) = expected, found %s",z->tok);
      return MERRTYP;
    }
  chval[0]=0;
  strcpy(chtyp,"fun[S[");
  do
    {
      if (Mreadtok(z))
        {
          sprintf(z->mess,"46) I or S or ;; expected");
          return MERRTYP;
        }
      if ((!strcmp(z->tok,"I"))||(!strcmp(z->tok,"S")))
        {
          sprintf(chval,"%s %s",chval,z->tok);
          sprintf(chtyp,"%s %s",chtyp,z->tok);
        }
      else if (strcmp(z->tok,";;"))
        {
          sprintf(z->mess,"47) I or S or ;; expected");
          return MERRTYP;
        }
    }
  while(strcmp(z->tok,";;"));
  strcat(chtyp,"]] Comm");
  big=(char*)&m->tape[(m->top[m->pp]>>1)+SizeHeader];
  MMechostr(MSKTRACE,"%s : %s (%s)\n",big,chtyp,chval);

  if (Mpushstring(m,chval)) return MERRMEM;
  if (Mpushstring(m,chtyp)) return MERRMEM;

  s=MMmalloc(m,SIZEVAR,TYPETAB); if (s==NIL) return MERRMEM;
  
  m->tape[s+SizeHeader+OFFVNAME]=m->top[m->pp+2];
  m->tape[s+SizeHeader+OFFVVAL] =m->top[m->pp+1];
  m->tape[s+SizeHeader+OFFVTYP] =TYPCOMV*2;
  m->tape[s+SizeHeader+OFFVSTYP]=m->top[m->pp];
  m->tape[s+SizeHeader+OFFVNEXT]=m->top[ind+PKGVAR];
//$ 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[ind+PKGVAR]=s+s+1;
  m->pp+=3;

  return 0;
}

/*  verification de type d'un fichier .pkg */
int TCtypecheck(mmachine m, manlyz z, int ind)
{
  int k;

  while(Mreadtok(z)==0)
    {
      if (!strcmp(z->tok,"typeof"))
        {
          if (Mreadtok(z))
            {
              sprintf(z->mess,"48) name of variable expected");
              return MERRTYP;
            }
          if (Mpushstring(m,z->tok)) return MERRMEM;
          if (k=TCgettypeof(m,z,ind)) return k;
        }
      else if (!strcmp(z->tok,"proto"))
        {
          if (Mreadtok(z))
            {
              sprintf(z->mess,"49) name of function expected");
              return MERRTYP;
            }
          if (Mpushstring(m,z->tok)) return MERRMEM;
          if (k=TCgetproto(m,z,ind)) return k;
        }
      else if (!strcmp(z->tok,"typedef"))
        {
          if (Mreadtok(z))
            {
              sprintf(z->mess,"50) name of type expected");
              return MERRTYP;
            }
          if ((z->tok[0]<'A')||(z->tok[0]>'Z'))
            {
              sprintf(z->mess,"51) Bad name of type");
              return MERRTYP;
            }
          if (Mpushstring(m,z->tok)) return MERRMEM;
          if (k=TCgettypedef(m,z,ind)) return k;
        }
      else if (!strcmp(z->tok, "defcom"))
      {
        if (Mreadtok(z))
        {
          sprintf(z->mess, "52) name of constructor expected");
          return MERRTYP;
        }
        if (!z->lex.current().is(Token::kIdent))
        {
          sprintf(z->mess, "53) Bad name of com constructor");
          return MERRTYP;
        }
        if (Mpushstring(m, z->tok)) return MERRMEM;
        if (k = TCgetdefcom(m, z, ind)) return k;
      }
      else if (!strcmp(z->tok,"defcomvar"))
        {
          if (Mreadtok(z))
            {
              sprintf(z->mess,"54) name of constructor expected");
              return MERRTYP;
            }
          if (!z->lex.current().is(Token::kIdent))
            {
              sprintf(z->mess,"55) Bad name of com constructor");
              return MERRTYP;
            }
          if (Mpushstring(m,z->tok)) return MERRMEM;
          if (k=TCgetdefcomvar(m,z,ind)) return k;
        }
      else if (!strcmp(z->tok,"struct"))
        {
          if (Mreadtok(z))
            {
              sprintf(z->mess,"56) name of type expected");
              return MERRTYP;
            }
          if ((z->tok[0]<'A')||(z->tok[0]>'Z'))
            {
              sprintf(z->mess,"57) Bad name of type");
              return MERRTYP;
            }
          if (Mpushstring(m,z->tok)) return MERRMEM;
          if (k=TCgetstruct(m,z,ind)) return k;
        }
      else if (!strcmp(z->tok,"var"))
        {
          if (Mreadtok(z))
            {
              sprintf(z->mess,"58) name of variable expected");
              return MERRTYP;
            }
          if (Mpushstring(m,z->tok)) return MERRMEM;
          if (k=TCgetvar(m,z,ind)) return k;
        }
      else if (!strcmp(z->tok,"fun"))
        {
          if (Mreadtok(z))
            {
              sprintf(z->mess,"59) name of function expected");
              return MERRTYP;
            }
          if (Mpushstring(m,z->tok)) return MERRMEM;
//MMechostr(0,"> TCtypecheck() - Fun: %s\n", z->tok);
          if (k=TCgetfun(m,z,ind)) return k;
        }
      else
        {
          sprintf(z->mess,"60) unknown %s",z->tok);
          return MERRTYP;
        }
    }
  return 0;
}

/*  remove "no more weak" mode from other pkg */
void TCtypeuncheck(mmachine m, manlyz z, int ind)
{
  while(Mreadtok(z)==0)
  {
    if ((!strcmp(z->tok,"typedef")) || (!strcmp(z->tok,"struct")))
    {
      if (!Mreadtok(z))
      {
        int i=Msearchtypinpak(m,m->top[ind+PKGLP],z->tok);

        if (i!=NIL)
        {
          int n=m->tape[i+SizeHeader+OFFVTYP]>>1;
          int v=m->tape[i+SizeHeader+OFFVVAL];
          if ((n==TYPTYPE)&&(v==NIL))
          {
            MMechostr(MSKDEBUG,"remove no more weak : %s\n", z->tok);
            m->tape[i+SizeHeader+OFFVVAL]=0;
            m->tape[i+SizeHeader]=NIL;
          }
        }
      }
    }
  }
}