/*     
      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 "lexer.h"
extern "C" {
#include "mmemory.h"
#include "listlab.h"
#include "loadpak.h"
int Mismagstd(const char* name);
}
//$ FA(27/03/2001) - Include code generator interface
#include "coder.h"
//
#include "opcode.h"

int MGnglob;

int PKreada(mmachine m,manlyz z,int ind);
int PKreadt(mmachine m,manlyz z,int ind);


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

// Primitive functions that are compiled into bytecodes
struct {
  char* name;
  int   arity;
  char* type;
  byte  opcode;
} specials[] = {
  { "sizetab",      1, "fun [tab u0] I",    kArraysize  },
  { "mktab",        2, "fun [I u0] tab u0", kNewarray   },
#if !defined (SCOL_STRICT)
  { "add",          2, "fun [I I] I",       kIntadd     },  // deprecated
  { "sub",          2, "fun [I I] I",       kIntsub     },  // deprecated
  { "mul",          2, "fun [I I] I",       kIntmul     },  // deprecated
  { "div",          2, "fun [I I] I",       kIntdiv     },  // deprecated
#endif
  { "mod",          2, "fun [I I] I",       kIntmod     },
#if !defined (SCOL_STRICT)
  { "neg",          1, "fun [I] I",         kIntneg     },  // deprecated
  { "and",          2, "fun [I I] I",       kIntand     },  // deprecated
  { "or",           2, "fun [I I] I",       kIntor      },  // deprecated
  { "eor",          2, "fun [I I] I",       kIntxor     },  // deprecated
  { "not",          1, "fun [I] I",         kIntnot     },  // deprecated
  { "shl",          2, "fun [u0 u0] I",     kIntshl     },  // deprecated
  { "shr",          2, "fun [u0 u0] I",     kIntshr     },  // deprecated
  { "eq",           2, "fun [I I] I",       kInteq      },  // deprecated
  { "ne",           2, "fun [I I] I",       kIntne      },  // deprecated
  { "lt",           2, "fun [I I] I",       kIntlt      },  // deprecated
  { "gt",           2, "fun [I I] I",       kIntgt      },  // deprecated
  { "le",           2, "fun [I I] I",       kIntle      },  // deprecated
  { "ge",           2, "fun [I I] I",       kIntge      },  // deprecated
  { "andb",         2, "fun [I I] I",       kBooland    },  // deprecated
  { "orb",          2, "fun [I I] I",       kBoolor     },  // deprecated
  { "non",          1, "fun [I] I",         kBoolnot    },  // deprecated
#endif
  { "itof",         1, "fun [I] F",         kInt2float  },
  { "ftoi",         1, "fun [F] I",         kFloat2int  },
#if !defined (SCOL_STRICT)
  { "addf",         2, "fun [F F] F",       kFloatadd   },  // deprecated
  { "subf",         2, "fun [F F] F",       kFloatsub   },  // deprecated
  { "mulf",         2, "fun [F F] F",       kFloatmul   },  // deprecated
  { "divf",         2, "fun [F F] F",       kFloatdiv   },  // deprecated
  { "negf",         1, "fun [F] F",         kFloatneg   },  // deprecated
  { "eqf",          2, "fun [F F] F",       kFloateq    },  // deprecated
  { "nef",          2, "fun [F F] I",       kFloatne    },  // deprecated
  { "ltf",          2, "fun [F F] I",       kFloatlt    },  // deprecated
  { "gtf",          2, "fun [F F] I",       kFloatgt    },  // deprecated
  { "lef",          2, "fun [F F] I",       kFloatle    },  // deprecated
  { "gef",          2, "fun [F F] I",       kFloatge    },  // deprecated
#endif
  { "break",        0, "fun [] I",          kBreak      },  // new!
  { "assert",       1, "fun [I] I",         kAssert     },  // new!
  { "mknode",       2, "fun [fun [u0 u1] u2 u1] fun [u0] u2",                                     kNewfun },
  { "mkfun1",       2, "fun [fun [u0] u1 u0] fun [] u1",                                          kNewfun },
  { "mkfun2",       2, "fun [fun [u0 u1] u2 u1] fun [u0] u2",                                     kNewfun },
  { "mkfun3",       2, "fun [fun [u0 u1 u2] u3 u2] fun [u0 u1] u3",                               kNewfun },
  { "mkfun4",       2, "fun [fun [u0 u1 u2 u3] u4 u3] fun [u0 u1 u2] u4",                         kNewfun },
  { "mkfun5",       2, "fun [fun [u0 u1 u2 u3 u4] u5 u4] fun [u0 u1 u2 u3] u5",                   kNewfun },
  { "mkfun6",       2, "fun [fun [u0 u1 u2 u3 u4 u5] u6 u5] fun [u0 u1 u2 u3 u4] u6",             kNewfun },
  { "mkfun7",       2, "fun [fun [u0 u1 u2 u3 u4 u5 u6] u7 u6] fun [u0 u1 u2 u3 u4 u5] u7",       kNewfun },
  { "mkfun8",       2, "fun [fun [u0 u1 u2 u3 u4 u5 u6 u7] u8 u7] fun [u0 u1 u2 u3 u4 u5 u6] u8", kNewfun }
};

//$ 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;
//$ 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);

}
