/*     
      MAGMA COMPILER . Magma 1.0 . 1996 . Sylvain HUET

         mcompile.cpp : routine de compilation
*/
// Modifications history
//
//$ FA(27/03/2001): Include code generator interface
//$ FA(27/03/2001): Reset code generator before generating bytecodes
//$ FA(27/03/2001): Substitute PUSH by call to code generator cgen() function
//$ FA(28/03/2001): Delete all occurrences of 'MGnbyt'
//$ FA(19/04/2001): Opcodes are defined in opcode.h
//$ FA(19/04/2001): Promoted to C++. Renamed from mcompile.c to mcompile.cpp
//$ FA(19/04/2001): Use new opcode mnemonics.
//$ FA(02/05/2001): Print a message telling the name of the function being compiled
//$ FA(03/05/2001): Use new lexer interface (lexer.h)
//$ FA(22/06/2001): Debugger integration. Add support for function trace
//$ FA(26/06/2001): Debugger integration. Link PB to function definition
//$ FA(17/07/2001): Replace MAXSIZETOKEN by MAXSIZETOKEN+1 in buffer definitions
//$ FA(08/08/2001): Support for local variable allocation/deallocation information
//$ FA(31/08/2001): Debugger integration. Add support for source position (BPTs)
//$ FA(12/11/2001): Replace SCOL_DEBUGGER_AWARE by INCLUDE_DEBUGGER except in those
//    cases where runtime information is updated
//


#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 "listlab.h"
}
//$ FA(27/03/2001): Include code generator interface
#include "compiler/coder.h"
//
#include "opcode.h"

int PKcompile(mmachine m, manlyz z, int ind);

extern int MGnglob;

/* lecture d'une sequence magma, mise a jour des variables
   globales utilisees, et creation d'un bloc bytecode
*/
int PKreadp(mmachine m,manlyz z,int ind);

/* lecture d'une sequence definissant une variable */
int PKreadvt(mmachine m,manlyz z,int ind);

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

  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;
        }

      if (Msearchlabel(m,m->top[ind+PKGLOC],z->tok)!=-1) return MERRTYP;
      if (k=Maddlabel(m,ind+PKGLOC,z->tok,nloc)) return k;
      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;
}

/* lecture d'une sequence magma, mise a jour des variables
   globales utilisees, et creation d'un bloc bytecode
*/
int PKempilemagm(mmachine m, manlyz z, int ind)
{
  int res;
  MGnglob = 0;

//$ FA(27/03/2001): Reset code generator before generating bytecodes
  CODER_RESET

//$ FA(14/12/2000): Add local variable name information
#if defined(INCLUDE_DEBUGGER)
  int nloc = 0;
  for (SEWORD loc = SEGET(m, ind+PKGLOC); loc != NIL; loc = SEFETCH(m, SEW2P(loc), OFFLBNEXT)) {
    CODER_WRITEOPCODE(kAddloc)
    CODER_WRITEBYTE(SEW2I(SEFETCH(m, SEW2P(loc), OFFLBNUM)))
    CODER_WRITESTRING(SECSTR(m, SEW2P(SEFETCH(m, SEW2P(loc), OFFLBNAME))))
	nloc++;
  }
#endif

  if (res = PKreadp(m, z, ind)) 
    return res;
//$ FA(14/12/2000): Add code to indicate that 'nloc' locals were removed
#if defined(INCLUDE_DEBUGGER)
  if (nloc) {
    CODER_WRITEOPCODE(kRemloc)
    CODER_WRITEINT16(nloc)
  }
#endif
//$ FA(27/03/2001): Substitute PUSH by call to code generator cgen() function
  CODER_WRITEOPCODE(kReturn)

//$ FA(25/04/2001): Perform tail-call optimisations
#if !defined(INCLUDE_DEBUGGER)
  CODER_OPTIMISE
#endif
//$ FA(27/03/2001): Save generated bytecodes in a SCOL block
#if defined(SCOL_DISASSEMBLER)
  CODER_DUMPASSEMBLER
#endif
  int block;
  if (CODER_SAVE(m, &block))
    return MERRMEM;
  SECHECK(SEPUSH(m, block));
  return MGnglob;
}

/* linkage des variables globales */
int PKlinkvar(mmachine m, manlyz z, int pkgs, int contxt, int first, int nglob)
{
  int c,i,j,s,q;
  char *p;
  
  if (nglob<=0)
    {
      if (MMpush(m,NIL)) return MERRMEM;
      return 0;
    }
  s=MMmalloc(m,nglob,TYPETAB); if (s==NIL) return MERRMEM;
  i=m->top[first];
  while(i!=NIL)
    {
      i>>=1;
      c=(m->tape[i+SizeHeader+OFFLBNAME]>>1);
      j=(m->tape[i+SizeHeader+OFFLBNUM]>>1);
      p=(char*)&m->tape[c+SizeHeader];
      q=Msearchvar(m,m->top[contxt],p);
      if (q==NIL)
        {
          /*recherche dans les autres pkgs*/
          q=Msearchinpak(m,m->top[pkgs],p);
          if (q==NIL)
            {
              sprintf(z->mess,"'%s' unknown\n",p);
              return MERRLINK;    /* linkage impossible */
            }
        }
      m->tape[s+SizeHeader+j]=q+q+1;

      i=m->tape[i+SizeHeader+OFFLBNEXT];
    }      
  if (MMpush(m,s+s+1)) return MERRMEM;
  return 0;
}

int PKmakeprog(mmachine m,int narg,int nloc)
{
  int s;

  s=MMmalloc(m,SIZEPROG,TYPETAB); if (s==NIL) return MERRMEM;
  m->tape[s+SizeHeader+OFFPARG] = narg*2;
  m->tape[s+SizeHeader+OFFPLOC] = nloc*2;
  m->tape[s+SizeHeader+OFFPBCD] = m->top[m->pp+1];
  m->tape[s+SizeHeader+OFFPREF] = m->top[m->pp];
  m->tape[s+SizeHeader+OFFPOPT] = NIL;
#if defined(RELEASE_DEVELOPER)
//$ FA(07/11/2000)
  m->tape[s+SizeHeader+OFFPVAR] = NIL;  // updated by PKgetfun()
//$ FA(18/11/2000)
  m->tape[s+SizeHeader+OFFPDBG] = 0;    // unset by default (no trace)
//$ FA(23/11/2000)
  m->tape[s+SizeHeader+OFFPBPT] = NIL;  // filled in by bytecode generator
//
#endif
  m->pp++;
  m->top[m->pp]=s+s+1;
  return 0;
}

int PKnloc;
int PKmaxnloc;

int PKgetfun(mmachine m, manlyz z, int ind)
{
  char name[MAXSIZETOKEN+1];
  int k,narg,nglob,i,q;

  strcpy(name,z->tok);
  m->top[ind+PKGGLB] = NIL;
  m->top[ind+PKGLOC] = NIL;
//$ FA(24/11/2000): Reset to a new empty BPT
#if defined(RELEASE_DEVELOPER)
  m->top[ind+PKGBPT] = NIL;
#endif
//
  if ((Mreadtok(z))||(z->tok[0]!='(')) /* liste des arguments */
    {
      sprintf(z->mess,"(arguments) expected");
      return MERRTYP;
    }
  PKmaxnloc=PKnloc=narg=PKreadloc(m,z,ind);
  if (narg<0) return narg;

  if ((Mreadtok(z))||(strcmp(z->tok,"=")))
    {
      sprintf(z->mess,"= expected");
      return MERRTYP;
    }
  
  /* lecture de magma */
  if (MMpush(m,m->top[ind+PKGVAR])) return MERRMEM;
  k=Msearchvar(m,m->top[ind+PKGVAR],name);
  if (k==NIL) k=Msearchinpak(m,m->top[ind+PKGLP],name);
  if (k==NIL) return MERRTYP;
  i=Mnbvar(m,m->top[ind+PKGVAR])-(m->tape[k+SizeHeader+OFFVVAL]>>1);
  q=Mnthvar(m,m->top[ind+PKGVAR],i); /* recherche dans le pkg courant */
  m->top[ind+PKGVAR]=q;

//$ FA(02/05/2001): Print a message telling the name of the function being compiled
  MMechostr(MSKTRACE, "Generating bytecodes for '%s'...\n", name);
//
  if ((nglob=PKempilemagm(m,z,ind))<0) return nglob;

  if ((Mreadtok(z))||(strcmp(z->tok,";;")))
    {
      sprintf(z->mess,";; expected");
      return MERRTYP;
    }
  
  /* linkage des variables globales */
  if (k=PKlinkvar(m,z,ind+PKGLP,ind+PKGVAR,ind+PKGGLB,nglob)) return k;
  
  /* creation d'une structure prog */
  if (k=PKmakeprog(m,narg,PKmaxnloc-narg)) return k;

  m->top[ind+PKGVAR]=m->top[m->pp+1];
  k=Msearchvar(m,m->top[ind+PKGVAR],name);
  if (k==NIL) k=Msearchinpak(m,m->top[ind+PKGLP],name);
  if (k==NIL) return MERRTYP;
  m->tape[k+SizeHeader+OFFVVAL]=m->top[m->pp];
#if defined(RELEASE_DEVELOPER)
//$ FA(07/11/2000): Link PB to function definition
  SESTORE(m, SEW2P(SEGETTOP(m, 0)), OFFPVAR, SEP2W(k));
//$ FA(24/11/2000): Set BPT in PB
  SESTORE(m, SEW2P(SEGETTOP(m, 0)), OFFPBPT, SEGET(m, ind+PKGBPT));
#endif

  m->pp+=2;

  return 0;
}

int PKgetvar(mmachine m, manlyz z, int ind)
{
  char name[MAXSIZETOKEN+1];
  int k;

  strcpy(name,z->tok);

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

  k=Msearchvar(m,m->top[ind+PKGVAR],name);
  if (k==NIL) k=Msearchinpak(m,m->top[ind+PKGLP],name);
  if (k==NIL) return MERRTYP;
  m->tape[k+SizeHeader+OFFVVAL]=m->top[m->pp];
  m->pp++;

  return 0;
}

int PKgettypeof(mmachine m, manlyz z,int ind)
{
  while((Mreadtok(z)==0)&&(strcmp(z->tok,";;")));
  return 0;
}

int PKgetproto(mmachine m, manlyz z,int ind)
{
  while((Mreadtok(z)==0)&&(strcmp(z->tok,";;")));
  return 0;
}

int PKgettypedef(mmachine m, manlyz z,int ind)
{
  while((Mreadtok(z)==0)&&(strcmp(z->tok,";;")));
  return 0;
}

int PKgetstruct(mmachine m, manlyz z,int ind)
{
  while((Mreadtok(z)==0)&&(strcmp(z->tok,";;")));
  return 0;
}

int PKgetdefcom(mmachine m, manlyz z,int ind)
{
  while((Mreadtok(z) == 0) && (strcmp(z->tok, ";;")));
  return 0;
}

int PKgetdefcomvar(mmachine m, manlyz z,int ind)
{
  while((Mreadtok(z)==0)&&(strcmp(z->tok,";;")));
  return 0;
}

/* seconde passe : lit le package et fait le linkage */
int PKcompile(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 (k=PKgettypeof(m,z,ind)) return k;
        }
      else if (!strcmp(z->tok,"proto"))
        {
          if (Mreadtok(z))
            {
              sprintf(z->mess,"name of function expected");
              return MERRTYP;
            }
          if (k=PKgetproto(m,z,ind)) return k;
        }
      else if (!strcmp(z->tok,"typedef"))
        {
          if (Mreadtok(z))
            {
              sprintf(z->mess,"name of type expected");
              return MERRTYP;
            }
          if (k=PKgettypedef(m,z,ind)) return k;
        }
      else if (!strcmp(z->tok,"defcom"))
      {
        if (Mreadtok(z))
        {
          sprintf(z->mess, "name of com constructor expected");
          return MERRTYP;
        }
        if (k = PKgetdefcom(m, z, ind)) return k;
      }
      else if (!strcmp(z->tok,"defcomvar"))
        {
          if (Mreadtok(z))
            {
              sprintf(z->mess,"name of com constructor expected");
              return MERRTYP;
            }
          if (k=PKgetdefcomvar(m,z,ind)) return k;
        }
      else if (!strcmp(z->tok,"struct"))
        {
          if (Mreadtok(z))
            {
              sprintf(z->mess,"name of type expected");
              return MERRTYP;
            }
          if (k=PKgetstruct(m,z,ind)) return k;
        }
      else if (!strcmp(z->tok,"var"))
        {
          if (Mreadtok(z))
            {
              sprintf(z->mess,"name of variable expected");
              return MERRTYP;
            }
          if (k=PKgetvar(m,z,ind)) return k;
        }
      else if (!strcmp(z->tok,"fun"))
        {
          if (Mreadtok(z))
            {
              sprintf(z->mess,"name of function expected");
              return MERRTYP;
            }
          if (k=PKgetfun(m,z,ind)) return k;
        }
      else
        {
          sprintf(z->mess,"unknown %s",z->tok);
          return MERRTYP;
        }
    }
  return 0;
}