/*     
      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
//

#include <stdio.h>
#include <string.h>
#include "debug.h"
#include "lexer.h"
#include "loadpak.h"
#include "macros.h"
extern "C" {
#include "mmemory.h"
#include "mbytec.h"
#include "mbytec2.h"
#include "listlab.h"
#include "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,"'%s' redefinition error",name);
      return MERRTYP;
  }
  if (i==NIL)
  {
	  i=Msearchinpak(m,m->top[ind+PKGLP],name);
      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,"'%s' redefinition of prototype error",name);
          return MERRTYP;
        }
	  if (m->tape[i+SizeHeader+OFFVTYP]!=n*2)
      {
		  sprintf(z->mess,"'%s' redefinition error",name);
          return MERRTYP;
      }

      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,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,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,"%s : proto %s doesn't match with %s\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,"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,"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,", 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;

  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,"(arguments) expected");
      return MERRTYP;
    }
  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;

  if ((Mreadtok(z))||(z->tok[0]!='=')) /* debut fonction */
    {
      sprintf(z->mess,"= 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,";; expected");
      return MERRTYP;
    }

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

  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,"= expected, found %s",z->tok);
      return MERRTYP;
    }

  if (Mreadtok(z))
    {
      sprintf(z->mess,"missing element");
      return MERRTYP;
    }
  if (k=TCreadvt(m,z,ind)) return k;

  if ((Mreadtok(z))||(strcmp(z->tok,";;")))
    {
      sprintf(z->mess,";; 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,"= expected, found %s",z->tok);
      return MERRTYP;
    }

  if (k=TPtypgraphanlzmono(m,z,ind))
    {
      sprintf(z->mess,"invalid type");
      return k;
    }
  if ((Mreadtok(z))||(strcmp(z->tok,";;")))
    {
      sprintf(z->mess,";; 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,"= expected, found %s",z->tok);
      return MERRTYP;
    }

  if (k=TPtypgraphanlz(m,z,ind))
    {
      sprintf(z->mess,"invalid type");
      return k;
    }
  if ((Mreadtok(z))||(strcmp(z->tok,";;")))
    {
      sprintf(z->mess,";; expected");
      return MERRTYP;
    }
  n=TPnbarg(m,m->top[m->pp]);
  if (n==-1)
    {
      sprintf(z->mess,"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,"type '%s' already defined",z->tok);
          return MERRTYP;
        }
    }

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

          if (Mreadtok(z))
            {
              sprintf(z->mess,"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,"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,";; or | expected");
              return MERRTYP;
            }
        }
      while(strcmp(z->tok,";;"));
    }
  else if (strcmp(z->tok,";;"))
    {
      sprintf(z->mess,"= 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,"type '%s' already defined",z->tok);
          return MERRTYP;
        }
    }

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

  do
    {
      if (Mreadtok(z))
        {
          sprintf(z->mess,"name of field expected");
          return MERRTYP;
        }
      if (Msearchvar(m,m->top[ind+PKGVAR],z->tok)!=NIL)
        {
          sprintf(z->mess,"'%s' already defined error",z->tok);
          return MERRTYP;
        }
      if (Mpushstring(m,z->tok)) return MERRMEM;
      if ((Mreadtok(z))||(strcmp(z->tok,":")))
        {
          sprintf(z->mess,": expected");
          return MERRTYP;
        }
          
      if (k=TPtypgraphanlzmono(m,z,ind))
        {
          sprintf(z->mess,"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,"] 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,"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,"'%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,";; 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,"'%s' already defined error",z->tok);
      return MERRTYP;
    }
  m->top[ind+PKGLOC]=NIL;
  if ((Mreadtok(z))||(z->tok[0]!='='))
    {
      sprintf(z->mess,"= expected, found %s",z->tok);
      return MERRTYP;
    }
  if ((Mreadtok(z))||(!z->lex.current().is(Token::kIdent)))
    {
      sprintf(z->mess,"name of command expected");
      return MERRTYP;
    }
  sprintf(chval,"%s",z->tok);
  strcpy(chtyp,"fun[[");
  do
    {
      if (Mreadtok(z))
        {
          sprintf(z->mess,"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,"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,"'%s' already defined error",z->tok);
      return MERRTYP;
    }
  m->top[ind+PKGLOC]=NIL;
  if ((Mreadtok(z))||(z->tok[0]!='='))
    {
      sprintf(z->mess,"= expected, found %s",z->tok);
      return MERRTYP;
    }
  chval[0]=0;
  strcpy(chtyp,"fun[S[");
  do
    {
      if (Mreadtok(z))
        {
          sprintf(z->mess,"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,"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,"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,"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,"name of type expected");
              return MERRTYP;
            }
          if ((z->tok[0]<'A')||(z->tok[0]>'Z'))
            {
              sprintf(z->mess,"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,"name of constructor expected");
              return MERRTYP;
            }
          if (!z->lex.current().is(Token::kIdent))
            {
              sprintf(z->mess,"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,"name of constructor expected");
              return MERRTYP;
            }
          if (!z->lex.current().is(Token::kIdent))
            {
              sprintf(z->mess,"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,"name of type expected");
              return MERRTYP;
            }
          if ((z->tok[0]<'A')||(z->tok[0]>'Z'))
            {
              sprintf(z->mess,"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,"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,"name of function expected");
              return MERRTYP;
            }
          if (Mpushstring(m,z->tok)) return MERRMEM;
          if (k=TCgetfun(m,z,ind)) return k;
        }
      else
        {
          sprintf(z->mess,"unknown %s",z->tok);
          return MERRTYP;
        }
    }
  return 0;
}