/*     
      BYTE CODE INTERPRETER . Magma 1.0 . 1996 . Sylvain HUET

         readmagm.cpp : module magma du loader de packages
*/
// Modification history
//
//$ FA(27/03/2001): Include code generator interface
//$ FA(27/03/2001): Substitute PUSH by call to code generator cgen() function
//$ FA(28/03/2001): Delete all occurrences of 'MGnbyt'
//$ FA(05/04/2001): Modify PKprepvar, PKreadset and PKvar to use new variable
//                  and field accessor bytecodes
//$ FA(06/04/2001): Modify PKreaduser and to PKreadcom use OPGETGLOBAL
//$ FA(06/04/2001): Modify PKreadlet2 to use OPGETFIELD and OPSETLOCAL
//$ FA(06/04/2001): Modify PKreadmatch to use OPGETFIELD
//$ FA(06/04/2001): Modify PKreadmutate to use OPSETFIELD
//$ FA(13/04/2001): Reorganise bytecodes. Introduce tables of 'specials' (compiled into
//                  opcodes) and 'primitives' (included in the standard runtime library)
//$ FA(13/04/2001): Rewrite Mismagstd() to return index into specials table. PKreadlab()
//                  was modified to use specials table
//$ FA(17/04/2001): Adapt compiler to use specialised getters and setters (OPGETLOCALi, etc)
//$ FA(19/04/2001): Promote file to C++. Renamed from readmagm.c to readmagm.cpp
//$ FA(19/04/2001): Use new opcode mnemonics as well as the new specialised 'pushint' bytecodes
//$ FA(20/04/2001): Use specialised 'newtuple' bytecodes
//$ FA(23/04/2001): Special functions deprecated are not available in SCOL_STRICT mode
//$ FA(23/04/2001): Use new 'arrayget', 'arrayset' and 'arraycheck' instructions
//$ FA(23/04/2001): Use optimised 'getfield' and 'setfield'
//$ FA(23/04/2001): Generate bounds checking code (if 'optionRuntimeChecks' is true)
//$ FA(26/04/2001): Add 'break' and 'assert' to the list of specials
//$ FA(03/05/2001): Use new lexer interface (lexer.h)
//$ FA(04/05/2001): Integrate floating-point syntax
//$ FA(08/08/2001): Support for local variable allocation/deallocation information
//$ FA(03/09/2001): Debugger integration. Add 'break's to implement function trace
//$ FA(12/11/2001): Replace SCOL_DEBUGGER_AWARE by INCLUDE_DEBUGGER
//

#include <stdio.h>
#include <string.h>
#include "debug.h"
#include "compiler/lexer.h"
extern "C" 
{
#   include "scolMMemory.h"
#   include "listlab.h"
#   include "loadpak.h"
int Mismagstd(const char* name);
}
//$ FA(27/03/2001) - Include code generator interface
#include "compiler/coder.h"

// Primitive functions that are compiled into bytecodes
#include "scolSpecialsFunctions.h"

int MGnglob;
int PKreada(mmachine m,manlyz z,int ind);
int PKreadt(mmachine m,manlyz z,int ind);
extern ScolSpecialFunction specials[SCOL_SPECIAL_FUNCTIONS_NUMBER];

extern "C" 
{
// Generate runtime checks if set to true
int optionRuntimeChecks = 0;
}

//$ FA(13/04/2001): Rewrite Mismagstd(name) to return index into specials table
int Mismagstd(const char *name)
{
  int i;

  for (i = 0; i < sizeof(specials)/sizeof(specials[0]); i++) 
    if (!strcmp(name, specials[i].name)) 
      return i;
  return -1;
}
//


/* prepare l'ecriture dans une variable : le premier token variable
  a deja ete lu (et verifie comme tel). La routine reconnait les index de 
  tableau */
//$ FA(05/04/2001): Two last arguments added to deal with new compilation scheme
int PKprepvar(mmachine m,manlyz z,int ind,Accessor *accessor,int *opn)
{
  int i,k,n;
  int res;

  i=Msearchlabel(m,m->top[ind+PKGLOC],z->tok);
  if (i!=-1)
    {
//$ FA(27/03/2001) - Substitute PUSH by call to code generator cgen() function
//$ FA(05/04/2001): Target is a local variable
	  *accessor = kAccessorLocal;
      *opn      = i;
//
    }
  else
    {
      i=Msearchlabel(m,m->top[ind+PKGGLB],z->tok);
      if (i==-1)
        {
          if (k=Maddlabel(m,ind+PKGGLB,z->tok,MGnglob)) return k;
          i=MGnglob++;
        }
//$ FA(27/03/2001) - Substitute PUSH by call to code generator cgen() function
//$ FA(05/04/2001): Target is a global variable
	  *accessor = kAccessorGlobal;
	  *opn      = i;
//
    }

  while(1)
    {
      if (Mreadtok(z)) return 0;
      if (z->tok[0]=='.')
        {
//$ FA(04/05/2001): Tell lexer not to detect floating-point constants here
          z->lex.setMode(Lexer::kModeDotAddressing);
//
          if (Mreadtok(z))
            {
              sprintf(z->mess,"missing term");
              return MERRTYP;
            }
          n=TYPVAR;
          if (z->lex.current().is(Token::kIdent))
            {
              i=Msearchlabel(m,m->top[ind+PKGLOC],z->tok);
              if (i==-1)
                {
                  i=Msearchvar(m,m->top[ind+PKGVAR],z->tok);
                  if (i==NIL)
                    i=Msearchinpak(m,m->top[ind+PKGLP],z->tok);
                  if (i!=NIL)
                    n=m->tape[i+SizeHeader+OFFVTYP]>>1;
                }
            }
//$ FA(05/04/2001): Target is a field (either struct or array)
	      if (res = writeAccessor(*accessor, true, *opn))
            return res;
//
          if (n==TYPFIELD)
            {
              i=m->tape[i+SizeHeader+OFFVVAL]>>1;
//$ FA(27/03/2001) - Substitute PUSH by call to code generator cgen() function
			  //MMechostr(MSKTRACE, "Generating 'int %d'\n", i);
		      *accessor = kAccessorField;
		      *opn      = i;
//
            }
          else
            {
              if (k=PKreadt(m,z,ind)) return k;
//
              // Generate bounds-checking code if needed
              if (optionRuntimeChecks)
                CODER_WRITEOPCODE(kArraycheck)
              *accessor = kAccessorArray;
              *opn      = 0;  // unused by writeAccessor()
            }
//$ FA(04/05/2001): Switch back to plain mode
            z->lex.setMode(Lexer::kModePlain);
//
        }
      else
        {
          z->giveback=1;
          return 0;
        }
    }
}


//$ FA(04/09/2001)
int PKreadadebug(mmachine m, manlyz z, int ind)
{
#if defined(INCLUDE_DEBUGGER)
  TextSpan span;
  span.beg = z->lex.current().span().beg;
  uint32 offb = CODER_OFFSET;
  CODER_WRITEOPCODE(kDebug)
#endif
  int res;
  if (res = PKreada(m, z, ind)) 
    return res;
#if defined(INCLUDE_DEBUGGER)
  uint32 offa = CODER_OFFSET;
  CODER_WRITEOPCODE(kDebug)
  span.end = z->lex.current().span().end;
  if (DBGAddBPT(m, ind, offb, span, kEvalBefore))
    return MERRMEM;
  if (DBGAddBPT(m, ind, offa, span, kEvalAfter))
    return MERRMEM;
#endif  
  return MERROK;
}
//


/* lecture d'une Expression (set V = X) (le 'set' a ete lu) */
int PKreadset(mmachine m,manlyz z,int ind)
{
  int k;
  Accessor accessor;
  int opn;
//$ FA(03/09/2001)
#if defined(INCLUDE_DEBUGGER)
  TextSpan span;
  span.beg = z->lex.current().span().beg;
  uint32 offb = CODER_OFFSET;
  CODER_WRITEOPCODE(kDebug)
#endif
//
  if ((Mreadtok(z))||(!z->lex.current().is(Token::kIdent)))
    {
      sprintf(z->mess,"variable expected");
      return MERRTYP;
    }
//$ FA(05/04/2001): Use modified PKprepvar()
  if (k=PKprepvar(m,z,ind,&accessor,&opn)) return k;
//
  if ((Mreadtok(z))||(strcmp(z->tok,"=")))
    {
      sprintf(z->mess,"= expected");
      return MERRTYP;
    }
  if (Mreadtok(z))
    {
      sprintf(z->mess,"missing expression");
      return MERRTYP;
    }
  //MMechostr(MSKTRACE, "Generating setter value\n");
  if (k=PKreadadebug(m,z,ind)) return k;

//$ FA(05/04/2001): Generate accessor bytecodes for setter
  int res;
  if (res = writeAccessor(accessor, false, opn))
    return res;
//$ FA(03/09/2001): Break after storing value
#if defined(INCLUDE_DEBUGGER)
  uint32 offa = CODER_OFFSET;
  CODER_WRITEOPCODE(kDebug)
  span.end = z->lex.current().span().end;
  if (DBGAddBPT(m, ind, offb, span, kEvalBefore))
    return MERRMEM;
  if (DBGAddBPT(m, ind, offa, span, kEvalAfter))
    return MERRMEM;
#endif
//
  return 0;
}

/* lecture d'une Expression (if C then T else F) (le 'if' a ete lu) */
int PKreadif(mmachine m,manlyz z,int ind)
{
  int k;
  int p0,p1;

//$ FA(04/09/2001)
#if defined(INCLUDE_DEBUGGER)
  TextSpan span;
  span.beg = z->lex.current().span().beg; // should be previous
  int32 offb = CODER_OFFSET;
  CODER_WRITEOPCODE(kDebug)
#endif
//
  if (Mreadtok(z))
    {
      sprintf(z->mess,"missing condition");
      return MERRTYP;
    }
  if (k=PKreadadebug(m,z,ind)) return k;   /* lecture condition */
//$ FA(27/03/2001) - Substitute PUSH by call to code generator cgen() function
  CODER_WRITEOPCODE(kIffalse)
//
//$ FA(27/03/2001) - Save offset of 'opelse' operand 
  CODER_WRITEHOLE(&p0)
//
  if ((Mreadtok(z))||(strcmp(z->tok,"then")))
    {
      sprintf(z->mess,"then expected");
      return MERRTYP;
    }
  if (Mreadtok(z))
    {
      sprintf(z->mess,"missing True condition");
      return MERRTYP;
    }
  if (k=PKreadadebug(m,z,ind)) return k;   /* lecture True */
//$ FA(27/03/2001) - Substitute PUSH by call to code generator cgen() function
  CODER_WRITEOPCODE(kGoto)
//
//$ FA(27/03/2001) - Save offset of 'goto' operand and backpatch 'else'
  CODER_WRITEHOLE(&p1)
  CODER_BACKPATCH(p0, CODER_OFFSET)
//
  if (Mreadtok(z)) return MERRTYP;
  if (strcmp(z->tok,"else"))
    {
      sprintf(z->mess,"else expected");
      return MERRTYP;
    }
  if (Mreadtok(z))
    {
      sprintf(z->mess,"missing False condition");
      return MERRTYP;
    }
  if (k=PKreadadebug(m,z,ind)) return k;   /* lecture False */
//$ FA(27/03/2001) - Backpatch 'goto' with offset beyond if
  CODER_BACKPATCH(p1, CODER_OFFSET)
//$ FA(04/09/2001)
#if defined(INCLUDE_DEBUGGER)
  int32 offa = CODER_OFFSET;
  CODER_WRITEOPCODE(kDebug)
  span.end = z->lex.current().span().end;
  if (DBGAddBPT(m, ind, offb, span, kEvalBefore))
    return MERRMEM;
  if (DBGAddBPT(m, ind, offa, span, kEvalAfter))
    return MERRMEM;
#endif
//
  return 0;
}

/* lecture d'une Expression (while C do E) (le 'while' a ete lu) */
int PKreadwhile(mmachine m,manlyz z,int ind)
{
  int k;
  int v0,p1;
//$ FA(04/09/2001)
#if defined(INCLUDE_DEBUGGER)
  TextSpan span;
  span.beg = z->lex.current().span().beg; // should be previous
  int32 offb = CODER_OFFSET;
  CODER_WRITEOPCODE(kDebug)
#endif
//$ FA(27/03/2001) - Substitute PUSH by call to code generator cgen() function
  CODER_WRITEOPCODE(kPushnil)
//
//$ FA(27/03/2001) - Save offset of loop test
  v0 = CODER_OFFSET;
//
  if (Mreadtok(z))
    {
      sprintf(z->mess,"missing expression");
      return MERRTYP;
    }
  if (k=PKreadadebug(m,z,ind)) return k;   /* lecture condition */
//$ FA(27/03/2001) - Substitute PUSH by call to code generator cgen() function
  CODER_WRITEOPCODE(kIffalse)
//
//$ FA(27/03/2001) - Save offset of 'else' operand
  CODER_WRITEHOLE(&p1)
//
  if ((Mreadtok(z))||(strcmp(z->tok,"do")))
    {
      sprintf(z->mess,"do expected");
      return MERRTYP;
    }
//$ FA(27/03/2001) - Substitute PUSH by call to code generator cgen() function
  CODER_WRITEOPCODE(kDrop)
//
  if (Mreadtok(z))
    {
      sprintf(z->mess,"missing expression");
      return MERRTYP;
    }
  if (k=PKreadadebug(m,z,ind)) return k;   /* lecture Corps */
//$ FA(27/03/2001) - Substitute PUSH by call to code generator cgen() function
  CODER_WRITEOPCODE(kGoto)
  CODER_WRITEOFFSET(v0)
//

//$ FA(27/03/2001) - Backpatch 'else' with offset beyond while
  CODER_BACKPATCH(p1, CODER_OFFSET)
//$ FA(04/09/2001)
#if defined(INCLUDE_DEBUGGER)
  int32 offa = CODER_OFFSET;
  CODER_WRITEOPCODE(kDebug)
  span.end = z->lex.current().span().end;
  if (DBGAddBPT(m, ind, offb, span, kEvalBefore))
    return MERRMEM;
  if (DBGAddBPT(m, ind, offa, span, kEvalAfter))
    return MERRMEM;
#endif
//
  return 0;
}


int PKletn;
extern int PKnloc;
extern int PKmaxnloc;


//$ FA(06/04/2001): Modify PKreadlet2 to use OPGETFIELD and OPSETLOCAL
int PKreadlet2(mmachine m,manlyz z,int ind)
{
  int k,n;
  int res;

  if (z->tok[0]=='[')
    {
      n=0;
      while(1)
        {
          if (Mreadtok(z))
            {
              sprintf(z->mess,"missing element");
              return MERRTYP;
            }
          if (z->tok[0]==']')
            {
//$ FA(27/03/2001): Substitute PUSH by call to code generator cgen() function
              CODER_WRITEOPCODE(kDrop)
// 
              return 0;
            }
          else if (!strcmp(z->tok,"_"))
                {
                  n++;
                }
          else
            {
//$ FA(27/03/2001): Substitute PUSH by call to code generator cgen() function
              CODER_WRITEOPCODE(kDup)
              if (res = writeAccessor(kAccessorField, true, n))
                return res;
			  //MMechostr(MSKTRACE, "Generating dup; int %d; getfield\n", n);
//
              if (k=PKreadlet2(m,z,ind)) return k;
              n++;
            }
        }
    }

  if (!z->lex.current().is(Token::kIdent))
    {
      sprintf(z->mess,"element expected %s",z->tok);
      return MERRTYP;
    }
//$ FA(27/03/2001): Substitute PUSH by call to code generator cgen() function
//$ FA(06/04/2001): Use 'setlocal'. Setlocal leaves the value to set on top of the stack,
//  so a 'drop' is necessary
  if (res = writeAccessor(kAccessorLocal, false, PKnloc))
    return res;
  CODER_WRITEOPCODE(kDrop)
//
//$ FA(14/12/2000): Add local variable name information
#if defined(INCLUDE_DEBUGGER)
  CODER_WRITEOPCODE(kAddloc)
  CODER_WRITEBYTE(PKnloc)
  CODER_WRITESTRING(z->tok)
#endif
//  
  if ((k=Maddlabel(m,ind+PKGLOC,z->tok,PKnloc++))<0) return k;
  if (PKnloc>PKmaxnloc) PKmaxnloc=PKnloc;
  PKletn++;
  return 0;
}



/* lecture d'une Expression (let E -> vars in E) (le 'let' a ete lu) */
int PKreadlet(mmachine m,manlyz z,int ind)
{
  int k,n;
//$ FA(04/09/2001)
#if defined(INCLUDE_DEBUGGER)
  TextSpan span;
  span.beg = z->lex.current().span().beg; // should be previous
  int32 offb = CODER_OFFSET;
  CODER_WRITEOPCODE(kDebug)
#endif
//
  if (Mreadtok(z))
    {
      sprintf(z->mess,"missing expression");
      return MERRTYP;
    }
  if (k=PKreadadebug(m,z,ind)) return k;   /* lecture expression */

  if ((Mreadtok(z))||(strcmp(z->tok,"->")))
    {
      sprintf(z->mess,"-> expected");
      return MERRTYP;
    }
  if (Mreadtok(z))
    {
      sprintf(z->mess,"missing element");
      return MERRTYP;
    }
  PKletn=0;
//$ FA(06/04/2001): Use modified PKreadlet2
  if (k=PKreadlet2(m,z,ind)) return k;
//
  n=PKletn;
  if ((Mreadtok(z))||(strcmp(z->tok,"in")))
    {
      sprintf(z->mess,"in expected");
      return MERRTYP;
    }
  if (Mreadtok(z))
    {
      sprintf(z->mess,"missing expression");
      return MERRTYP;
    }
  if (k=PKreadadebug(m,z,ind)) return k;   /* lecture expression */

  Mdelnlabel(m,ind+PKGLOC,n);
  PKnloc-=n;
//$ FA(14/12/2000): Add local variable name information
#if defined(INCLUDE_DEBUGGER)
  CODER_WRITEOPCODE(kRemloc)
  CODER_WRITEINT16(n)
//$ FA(04/09/2001)
  int32 offa = CODER_OFFSET;
  CODER_WRITEOPCODE(kDebug)
  span.end = z->lex.current().span().end;
  if (DBGAddBPT(m, ind, offb, span, kEvalBefore))
    return MERRMEM;
  if (DBGAddBPT(m, ind, offa, span, kEvalAfter))
    return MERRMEM;
#endif
//
  return 0;
}

/* lecture d'une Expression (match E with (const x ->E) (le 'match' a ete lu)*/
int PKreadmatch(mmachine m,manlyz z,int ind)
{
  int k,n,nm,i;
  int pelse,pend;
//$ FA(04/09/2001)
#if defined(INCLUDE_DEBUGGER)
  TextSpan span;
  span.beg = z->lex.current().span().beg; // should be previous
  int32 offb = CODER_OFFSET;
  CODER_WRITEOPCODE(kDebug)
#endif
//
  if (Mreadtok(z)) return MERRTYP;
  if (k=PKreadadebug(m,z,ind)) return k;   /* lecture expression */
  if ((Mreadtok(z))||(strcmp(z->tok,"with")))
  {
	  sprintf(z->mess,"'with' expected");
	  return MERRTYP;
  }

  pend=-1;
  nm=0;
  do
    {
      if ((Mreadtok(z))||(strcmp(z->tok,"(")))
        {
          sprintf(z->mess,"'(' expected");
          return MERRTYP;
        }
      if (Mreadtok(z))
        {
          sprintf(z->mess,"missing constructor");
          return MERRTYP;
        }

      if (!strcmp(z->tok,"_"))
        {
//$ FA(27/03/2001) - Substitute PUSH by call to code generator cgen() function
		  CODER_WRITEOPCODE(kDrop)
//
          n=-1;
          pelse=-1;
        }
      else
        {
          i=Msearchlabel(m,m->top[ind+PKGLOC],z->tok);
          if (i!=-1)
            {
              sprintf(z->mess,"constructor expected");
              return MERRTYP;
            }
          i=Msearchvar(m,m->top[ind+PKGVAR],z->tok);
          if (i==NIL)
            i=Msearchinpak(m,m->top[ind+PKGLP],z->tok);
          if (i==NIL)
            {
              sprintf(z->mess,"constructor expected");
              return MERRTYP;
            }
          k=m->tape[i+SizeHeader+OFFVTYP]>>1;
          if ((k!=TYPCONS)&&(k!=TYPCONS0)) return MERRTYP;

          i=m->tape[i+SizeHeader+OFFVVAL]>>1;
//$ FA(27/03/2001): Substitute PUSH by call to code generator cgen() function
          CODER_WRITEOPCODE(kDup)
//$ FA(06/04/2001): Use 'getfield'. We could use specialised 'getfield0'
		  CODER_WRITEOPCODE(kGetfield0)
          int res;
          if (res = writePushint(i))
            return res;
		  CODER_WRITEOPCODE(kInteq)
		  CODER_WRITEOPCODE(kIffalse)
//
//$ FA(27/03/2001): Save current bytecode offset
		  CODER_WRITEHOLE(&pelse)
//
          if (k==TYPCONS0)
            {
//$ FA(27/03/2001): Substitute PUSH by call to code generator cgen() function
              CODER_WRITEOPCODE(kDrop)
//
              n=0;
            }
          else
            {
//$ FA(27/03/2001): Substitute PUSH by call to code generator cgen() function
//$ FA(06/04/2001): Use 'getfield'. We could use specialised 'getfield1'
			  CODER_WRITEOPCODE(kGetfield1)
//
              
              if (Mreadtok(z))
                {
                  sprintf(z->mess,"missing element");
                  return MERRTYP;
                }
              PKletn=0;
//$ FA(06/04/2001): Use modified PKreadlet2
              if (k=PKreadlet2(m,z,ind)) return k;
//
              n=PKletn;
            }
        }
      if ((Mreadtok(z))||(strcmp(z->tok,"->"))) return MERRTYP;
      if (Mreadtok(z)) return MERRTYP;
      if (k=PKreadadebug(m,z,ind)) return k;   /* lecture expression */
      if (n!=-1)
        {
//$ FA(14/12/2000) - Add local variable name information
#if defined(INCLUDE_DEBUGGER)
          CODER_WRITEOPCODE(kRemloc)
          CODER_WRITEINT16(n)
#endif
//$ FA(27/03/2001) - Substitute PUSH by call to code generator cgen() function
          CODER_WRITEOPCODE(kGoto)
		  CODER_WRITEOFFSET(pend)
//
//$ FA(27/03/2001) - Save current bytecode offset
          pend = CODER_LASTOFFSET;
//$ FA(27/03/2001) - Backpatch
		  CODER_BACKPATCH(pelse, CODER_OFFSET)
//
          Mdelnlabel(m,ind+PKGLOC,n);
          PKnloc-=n;
        }
      nm++;
      if ((Mreadtok(z))||(strcmp(z->tok,")"))) return MERRTYP;
      if (Mreadtok(z)) return MERRTYP;
      if (strcmp(z->tok,"|")) z->giveback=1;
    }
  while(!strcmp(z->tok,"|"));
  if (n!=-1)
    {
//$ FA(27/03/2001) - Substitute PUSH by call to code generator cgen() function
      CODER_WRITEOPCODE(kDrop)
	  CODER_WRITEOPCODE(kPushnil)
//
    }
  while(pend!=-1)
    {
      i = CODER_GETINT32(pend);
//$ FA(27/03/2001) - Backpatch
	  CODER_BACKPATCH(pend, CODER_OFFSET)
//
      pend = i;
    }
//$ FA(04/09/2001)
#if defined(INCLUDE_DEBUGGER)
  int32 offa = CODER_OFFSET;
  CODER_WRITEOPCODE(kDebug)
  span.end = z->lex.current().span().end;
  if (DBGAddBPT(m, ind, offb, span, kEvalBefore))
    return MERRMEM;
  if (DBGAddBPT(m, ind, offa, span, kEvalAfter))
    return MERRMEM;
#endif
//
  return 0;
}

/* lecture d'une Expression (mutate C <- E) (le 'mute' a ete lu) */
int PKreadmutate(mmachine m,manlyz z,int ind)
{
  int k,n;
//$ FA(04/09/2001)
#if defined(INCLUDE_DEBUGGER)
  TextSpan span;
  span.beg = z->lex.current().span().beg; // should be previous
  int32 offb = CODER_OFFSET;
  CODER_WRITEOPCODE(kDebug)
#endif
//
  if (Mreadtok(z))
    {
      sprintf(z->mess,"missing expression");
      return MERRTYP;
    }
  if (k=PKreadadebug(m,z,ind)) return k;   /* lecture expression */

  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;
  while(1)
    {
      if (Mreadtok(z))
        {
          sprintf(z->mess,"] or element expected");
          return MERRTYP;
        }
      if (z->tok[0]==']') {
//$ FA(04/09/2001)
#if defined(INCLUDE_DEBUGGER)
          int32 offa = CODER_OFFSET;
          CODER_WRITEOPCODE(kDebug)
          span.end = z->lex.current().span().end;
          if (DBGAddBPT(m, ind, offb, span, kEvalBefore))
            return MERRMEM;
          if (DBGAddBPT(m, ind, offa, span, kEvalAfter))
            return MERRMEM;
#endif
//
          return 0;
      }
      if (strcmp(z->tok,"_"))
        {
//$ FA(27/03/2001) - Substitute PUSH by call to code generator cgen() function
          CODER_WRITEOPCODE(kDup)
//
          if (k=PKreadadebug(m,z,ind)) return k;
//$ FA(27/03/2001) - Substitute PUSH by call to code generator cgen() function
          int res;
          if (res = writeAccessor(kAccessorField, false, n))
            return res;
		  CODER_WRITEOPCODE(kDrop)
//
        }
      n++;
    }
}

/* lecture d'une Expression utilisateur (V L) (le 'V' a ete lu) */
int PKreaduser(mmachine m,manlyz z,int ind, int n)
{
  int k,i,j;
  int nl;
//$ FA(04/09/2001)
#if defined(INCLUDE_DEBUGGER)
  TextSpan span;
  span.beg = z->lex.current().span().beg; // should be previous
  int32 offb = CODER_OFFSET;
  CODER_WRITEOPCODE(kDebug)
#endif
//
  nl=n;
  if (n==TYPSTRUC) n=1;
  if (n<0) return MERRTYP;

  i=Msearchlabel(m,m->top[ind+PKGGLB],z->tok);
  if (i==-1)
    {
      if (k=Maddlabel(m,ind+PKGGLB,z->tok,MGnglob)) return k;
      i=MGnglob++;
    }

  for(j=0;j<n;j++)
    {
      if (Mreadtok(z))
        {
          sprintf(z->mess,"missing argument");
          return MERRTYP;
        }
      if (k=PKreadadebug(m,z,ind)) return k;
    }
  if (nl==TYPSTRUC) return 0;
//$ FA(27/03/2001): Substitute PUSH by call to code generator cgen() function
//$ FA(06/04/2001): Modify PKreaduser to use OPGETGLOBAL
  int res;
  if (res = writeAccessor(kAccessorGlobal, true, i))
    return res;
  CODER_WRITEOPCODE(kCall)
//$ FA(04/09/2001)
#if defined(INCLUDE_DEBUGGER)
  int32 offa = CODER_OFFSET;
  CODER_WRITEOPCODE(kDebug)
  span.end = z->lex.current().span().end;
  if (DBGAddBPT(m, ind, offb, span, kEvalBefore))
    return MERRMEM;
  if (DBGAddBPT(m, ind, offa, span, kEvalAfter))
    return MERRMEM;
#endif
//
  return 0;
}

/* lecture d'une Expression structure */
int PKreadstruc(mmachine m,manlyz z,int ind, int n)
{
  int k;

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


/* lecture d'une construction de comm (le constructeur a ete lu) */
int PKreadcom(mmachine m, manlyz z, int ind, int n)
{
  int k, i, j, typ;
  int res;

//MMechostr(0,"PKreadcom\n");

//$ FA(04/09/2001)
#if defined(INCLUDE_DEBUGGER)
  TextSpan span;
  span.beg = z->lex.current().span().beg; // should be previous
  int32 offb = CODER_OFFSET;
  CODER_WRITEOPCODE(kDebug)
#endif
//
  if (n == TYPCOM)
  {
    n = 1;
    typ = kNewcomm;
  }
  else 
  {
    n = 2;
    typ = kNewcommvar;
  }
  
  i = Msearchlabel(m, m->top[ind+PKGGLB], z->tok);
  if (i == -1)
  {
    if (k = Maddlabel(m, ind+PKGGLB, z->tok, MGnglob)) return k;
    i = MGnglob++;
  }

  for(j = 0; j < n; j++)
  {
	  if (Mreadtok(z))
    {
      sprintf(z->mess, "missing argument");
      return MERRTYP;
    }
    if (k = PKreadadebug(m, z, ind)) return k;
  }
//$ FA(27/03/2001): Substitute PUSH by call to code generator cgen() function
//$ FA(06/04/2001): Modify PKreadcom to use OPGETGLOBAL
  if (res = writeAccessor(kAccessorGlobal, true, i))
    return res;
  CODER_WRITEOPCODE(typ)
//$ FA(04/09/2001)
#if defined(INCLUDE_DEBUGGER)
  int32 offa = CODER_OFFSET;
  CODER_WRITEOPCODE(kDebug)
  span.end = z->lex.current().span().end;
  if (DBGAddBPT(m, ind, offb, span, kEvalBefore))
    return MERRMEM;
  if (DBGAddBPT(m, ind, offa, span, kEvalAfter))
    return MERRMEM;
#endif
//
  return 0;
}


/* lecture d'un constructeur (Constr A) (le 'Constr' a ete lu) */
int PKreadconstr(mmachine m,manlyz z,int ind, int typ, int n)
{
  int k,i;
  int res;
//$ FA(04/09/2001)
#if defined(INCLUDE_DEBUGGER)
  TextSpan span;
  span.beg = z->lex.current().span().beg; // should be previous
  int32 offb = CODER_OFFSET;
  CODER_WRITEOPCODE(kDebug)
#endif
//$ FA(27/03/2001) - Substitute PUSH by call to code generator cgen() function
  if (res = writePushint(n))
    return res;
//
  if (typ==TYPCONS) i=1; 
  else i=0;

  if (i)
    {
      if (Mreadtok(z))
        {
          sprintf(z->mess,"missing argument");
          return MERRTYP;
        }
      if (k=PKreadadebug(m,z,ind)) return k;
    }
//$ FA(27/03/2001) - Substitute PUSH by call to code generator cgen() function
  if (res = writeNewtuple(1+i))
    return res;
//$ FA(04/09/2001)
#if defined(INCLUDE_DEBUGGER)
  int32 offa = CODER_OFFSET;
  CODER_WRITEOPCODE(kDebug)
  span.end = z->lex.current().span().end;
  if (DBGAddBPT(m, ind, offb, span, kEvalBefore))
    return MERRMEM;
  if (DBGAddBPT(m, ind, offa, span, kEvalAfter))
    return MERRMEM;
#endif
//
  return 0;
}


/* lecture d'une variable */
int PKvar(mmachine m,manlyz z,int ind)
{
  int k;
  Accessor accessor;
  int opn;
  int res;

  if (!z->lex.current().is(Token::kIdent))
    {
      sprintf(z->mess,"variable expected");
      return MERRTYP;
    }
//$ FA(05/04/2001): Use modified PKprepvar
  if (k=PKprepvar(m,z,ind,&accessor,&opn)) return k;
//$ FA(27/03/2001): Substitute PUSH by call to code generator cgen() function
//$ FA(05/04/2001): Generate accessor bytecodes
  if (res = writeAccessor(accessor, true, opn))
    return res;
//
  return 0;
}

/* lecture d'une Expression (exec F with X) (le 'exec' a ete lu) */
int PKreadexec(mmachine m,manlyz z,int ind)
{
  int k;
#if defined(INCLUDE_DEBUGGER)
  TextSpan span;
  span.beg = z->lex.current().span().beg; // should be previous
  int32 offb = CODER_OFFSET;
  CODER_WRITEOPCODE(kDebug)
#endif
  if (Mreadtok(z))
    {
      sprintf(z->mess,"missing function");
      return MERRTYP;
    }
  if (k=PKreadadebug(m,z,ind)) return k;   /* lecture fonction */
  if ((Mreadtok(z))||(strcmp(z->tok,"with")))
    {
      sprintf(z->mess,"with expected");
      return MERRTYP;
    }
  if (Mreadtok(z))
    {
      sprintf(z->mess,"missing arguments");
      return MERRTYP;
    }
  if (k=PKreadadebug(m,z,ind)) return k;   /* lecture arguments */
//$ FA(25/04/2001): Restrict exec/with syntax to 'exec e with [e0,...,eN]'
//  if (z->tok[0] == '[') {
//    uint args = 0;
//    for (;;) {
//      if (Mreadtok(z)) {
//        sprintf(z->mess, "argument to exec-expression expected after '['");
//        return MERRTYP;
//      }
//      if (z->tok[0] == ']')
//        break;
//      if (k = PKreada(m, z, ind))
//        return k;
//      args++;
//    } // for
//  /* Incomplete! */
//  } else {
//    sprintf(z->mess, "'[' expected after 'with' in exec-expression");
//    return MERRTYP;
//  }
//$ FA(27/03/2001): Substitute PUSH by call to code generator cgen() function
  CODER_WRITEOPCODE(kExeccall)
//$ FA(04/09/2001)
#if defined(INCLUDE_DEBUGGER)
  int32 offa = CODER_OFFSET;
  CODER_WRITEOPCODE(kDebug)
  span.end = z->lex.current().span().end;
  if (DBGAddBPT(m, ind, offb, span, kEvalBefore))
    return MERRMEM;
  if (DBGAddBPT(m, ind, offa, span, kEvalAfter))
    return MERRMEM;
#endif
//
  return 0;
}

int PKreadlab(mmachine m, manlyz z, int ind)
{
  int i,j,k,n;

  if (!strcmp(z->tok, "set")) 		return PKreadset(m, z, ind);
  if (!strcmp(z->tok, "if")) 			return PKreadif(m, z, ind);
  if (!strcmp(z->tok, "while")) 	return PKreadwhile(m, z, ind);
  if (!strcmp(z->tok, "let")) 		return PKreadlet(m, z, ind);
  if (!strcmp(z->tok, "match")) 	return PKreadmatch(m, z, ind);
  if (!strcmp(z->tok, "mutate")) 	return PKreadmutate(m, z, ind);
  if (!strcmp(z->tok, "exec")) 		return PKreadexec(m, z, ind);


  i = Msearchlabel(m, m->top[ind+PKGLOC], z->tok);
  if (i != -1) return PKvar(m, z, ind);
  i = Msearchvar(m, m->top[ind+PKGVAR], z->tok);
  if (i == NIL)
    i = Msearchinpak(m, m->top[ind+PKGLP], z->tok);
  if (i == NIL)
  {

//$ FA(13/04/2001): Mismagstd() returns index into specials table 
  	if ((i=Mismagstd(z->tok))!=-1) 
  	{
//$ FA(03/09/2001)
#if defined(INCLUDE_DEBUGGER)
			TextSpan span;                           
			bool     gencode = true;
#endif
//$ FA(26/04/2001): Disable writer if bytecode is 'assert' and runtime-check option is off
			if (specials[i].opcode == kAssert && !optionRuntimeChecks)
			{
				CODER_SETWRITERSTATE(BytecodeStream::kWriterStateDisabled)
#if defined(INCLUDE_DEBUGGER)
				gencode = false;
			} 
			else
				span.beg = z->lex.current().span().beg; //$ FA(03/09/2001)
#else
			}
#endif
//
			for(j = 0; j < specials[i].arity; j++)
		  {
		    if (Mreadtok(z))
	      {
	        sprintf(z->mess, "missing argument");
	        return MERRTYP;
	      }
		    if (k = PKreadadebug(m, z, ind)) return k;
		  }
//$ FA(03/09/2001)
#if defined(INCLUDE_DEBUGGER)
      int32 offb;
      if (gencode) 
      {
        span.end = z->lex.current().span().end;
        offb = CODER_OFFSET;
        CODER_WRITEOPCODE(kDebug)
      }
#endif
//$ FA(27/03/2001): Substitute PUSH by call to code generator cgen() function
			CODER_WRITEOPCODE(specials[i].opcode)
//$ FA(26/04/2001): 'Assert' bytecode takes the line number as operand
      if (specials[i].opcode == kAssert) 
      {
        // Does not generate code for 'assert' if runtime-checks option is off
        if (!optionRuntimeChecks) 
        {
          CODER_SETWRITERSTATE(BytecodeStream::kWriterStateEnabled)
          CODER_WRITEOPCODE(kPushnil)
        } 
        else
          CODER_WRITEINT32(z->lex.current().span().beg.line+1)
      }
//$ FA(03/09/2001)
#if defined(INCLUDE_DEBUGGER)
      if (gencode) 
      {
        int32 offa = CODER_OFFSET;
        CODER_WRITEOPCODE(kDebug)
        if (DBGAddBPT(m, ind, offb, span, kEvalBefore))
          return MERRMEM;
        if (DBGAddBPT(m, ind, offa, span, kEvalAfter))
          return MERRMEM;
      }
#endif
//
    	return 0;
  	}

    sprintf(z->mess, "'%s' unknown\n", z->tok);
    return MERRLINK;    /* linkage impossible */
  }
  n = m->tape[i+SizeHeader+OFFVTYP]>>1;
  if (n == TYPVAR) return PKvar(m, z, ind);
  if ((n == TYPCONS) || (n == TYPCONS0))
    return PKreadconstr(m, z, ind, n, m->tape[i+SizeHeader+OFFVVAL]>>1);
  if (n == TYPSTRUC)
    return PKreadstruc(m, z, ind, n);
  if ((n == TYPCOM) || (n == TYPCOMV))
    return PKreadcom(m, z, ind, n);

  return PKreaduser(m, z, ind, n);
}