/*     
      MEMORY MANAGER . Magma 1.0 . 1996 . Sylvain HUET

         fonctions
*/
//$ ER(10/07/2001): Declaration of maxsock put in comment
//$ FA(12/09/2001): Move blocks in MMgcfourth() using memmove()
//$ FA(14/09/2001): Dump core if preprocessor constant SCOL_DUMP_CORE is #defined
//$ FA(12/11/2001): Prints call stack (and a timestamp) at each GC (for the dev release only)
//

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#if defined(RELEASE_DEVELOPER)
#include <time.h>
#endif

#include "include/vscol.h"
#include "include/kernel.h"
#include "mmemory.h"
#include "mbytec.h"


char MMbuf[1024];

#if !defined(SCOL_DUMP_CORE) && defined(RELEASE_DEVELOPER)
#define SCOL_DUMP_CORE
#endif

#define TESTSGC

int MMpc(void);

int MMgcfirstSpec(mmachine m)
{
  int i,k,j,n;
  int first;

  first=-1;
  for(i=m->pp;i</*m->sizetape*/0;i++) // PPNEG MODIFIER
    if (i!=m->maxpp+3)
	{
      k=m->top[i];
      if ((k&1)&&(k!=NIL))
        {
          k>>=1;
#ifdef SCOL_DUMP_CORE
        if ((k<0)||(k>=m->sizetape))
        {
           MMechostr(MSKRUNTIME,"bad pointer firstSpec1\n");
           MMcore(m);
        }
#endif          
          if ((m->tape[k+1]&1)==0)
            {
              m->tape[k+1]|=1;
              m->tape[k+2]=first;
              first=k;
            }
        }
    }
	else
	{
		k=m->top[i];
		while(k!=NIL)
		{
			j=m->tape[(k>>1)+SizeHeader]>>1;
#ifdef VERSION_WIN
            if ((j!=NIL)&&(m->tape[j+SizeHeader+2]!=OBJtypebyname("OBJTYPBITMAP")*2)&&((m->tape[j+1]&1)==0))
#else
			if ((j!=NIL)&&((m->tape[j+1]&1)==0))
#endif
			{
				m->tape[j+1]|=1;
				m->tape[j+2]=first;
				first=j;
			}
			k=m->tape[(k>>1)+SizeHeader+1];
		}
	}

  while(first!=-1)
    {
      k=first;
      first=m->tape[k+2];
      n=m->tape[k];
      if (n&1)        /* table d'objets ? */
        {
          n>>=1;
          j=k+SizeHeader;
          for(i=0;i<n;i++)
            {
              k=m->tape[j+i];
              if ((k&1)&&(k!=NIL))
                {
                  k>>=1;
#ifdef SCOL_DUMP_CORE
        if ((k<0)||(k>=m->sizetape))
        {
            MMechostr(MSKRUNTIME,"bad pointer firstSpec2\n");
            MMcore(m);
        }
#endif          
                  if ((m->tape[k+1]&1)==0)
                    {
                      m->tape[k+1]|=1;
                      m->tape[k+2]=first;
                      first=k;
                    }
                }     
            }
        }
    }

  return 0;
}

int MMgcsecondSpec(mmachine m)
{
  int pos,newpos,realsize;

  pos=newpos=0;

  while(pos < m->topheap)
    {
      realsize=(m->tape[pos]>>1)+SizeHeader;
      m->tape[pos+1]&=~1;
      pos+=realsize;
    }
  return 0;
}

int MMgcfirst(mmachine m)
{
  int i,k,j,n;
  int first;

  first=-1;
  for(i=m->maxpp+3;i<m->maxpp+4;i++)
/*  for(i=m->pp;i<m->sizetape;i++)*/
    {
      k=m->top[i];
      if ((k&1)&&(k!=NIL))
        {
          k>>=1;
#ifdef SCOL_DUMP_CORE
        if ((k<0)||(k>=m->sizetape))
        {
           MMechostr(MSKRUNTIME,"bad pointer first1\n");
           MMcore(m);
        }
#endif          
          if ((m->tape[k+1]&1)==0)
            {
              m->tape[k+1]|=1;
              m->tape[k+2]=first;
              first=k;
            }
        }
    }
  while(first!=-1)
    {
      k=first;
      first=m->tape[k+2];
      n=m->tape[k];
      if (n&1)        /* table d'objets ? */
        {
          n>>=1;
          j=k+SizeHeader;
          for(i=0;i<n;i++)
            {
              k=m->tape[j+i];
              if ((k&1)&&(k!=NIL))
                {
                  k>>=1;
#ifdef SCOL_DUMP_CORE
        if ((k<0)||(k>=m->sizetape))
        {
            MMechostr(MSKRUNTIME,"bad pointer first2\n");
            MMcore(m);
        }
#endif          
                  if ((m->tape[k+1]&1)==0)
                    {
                      m->tape[k+1]|=1;
                      m->tape[k+2]=first;
                      first=k;
                    }
                }     
            }
        }
    }

  return 0;
}

int MMgcsecond(mmachine m)
{
  int pos,newpos,realsize;

  pos=newpos=0;

  while(pos < m->topheap)
    {
      realsize=(m->tape[pos]>>1)+SizeHeader;
#ifdef TESTSGC
	  if (realsize<=0) MMechostr(MSKDEBUG,"realsize=%x\n",realsize);
#endif
      if (m->tape[pos+1]&1)
        {
          m->tape[pos+1]=newpos<<1;
          newpos+=realsize;
        }
      pos+=realsize;
    }
  return 0;
}

int MMgcthird(mmachine m)
{
  int i,k,j,n;
  int first;

  first=-1;
  for(i=m->pp;i</*m->sizetape*/0;i++) // PPNEG MODIFIER
    {
      k=m->top[i];
      if ((k&1)&&(k!=NIL))
        {
          k>>=1;
          m->top[i]=m->tape[k+1]|1;
          if ((m->tape[k+1]&1)==0)
            {
              m->tape[k+1]|=1;
              m->tape[k+2]=first;
              first=k;
            }
        }
    }
  while(first!=-1)
    {
      k=first;
      first=m->tape[k+2];
      n=m->tape[k];
      if (n&1)        /* table d'objets ? */
        {
          n>>=1;
          j=k+SizeHeader;
          for(i=0;i<n;i++)
            {
              k=m->tape[j+i];
              if ((k&1)&&(k!=NIL))
                {
                  k>>=1;
                  m->tape[j+i]=m->tape[k+1]|1;
                  if ((m->tape[k+1]&1)==0)
                    {
                      m->tape[k+1]|=1;
                      m->tape[k+2]=first;
                      first=k;
                    }
                }     
            }
        }
    }

  return 0;
}

int MMgcfourth(mmachine m)
{
  int pos,newpos,realsize;

  pos=newpos=0;

  while(pos < m->topheap)
    {
      realsize=(m->tape[pos]>>1)+SizeHeader;
#ifdef TESTSGC
	  if (realsize<=0) MMechostr(MSKDEBUG,"realsize=%x\n",realsize);
#endif
      
      if (m->tape[pos+1]&1)
        {
          m->tape[pos+1]=0;
          //$ FA(12/09/2001): Copy block using memmove()
          memmove(&m->tape[newpos], &m->tape[pos], realsize*sizeof(int));
          newpos += realsize;
          pos    += realsize;
        }
      else
        pos+=realsize;
    }

  m->topheap=newpos;
  return 0;
}

/*
   Garbage Collector d'une machine
*/
int OBJfindFloatBmp(mmachine m);

//$ ER(10/07/01) : declaration of maxsock is done in vscol.h
// extern int maxsock; /*FLIC*/

int MMgc(mmachine m)
{
#if defined(RELEASE_DEVELOPER)
  time_t timestamp = time(NULL);
#endif
if (maxsock+101>MAXSOCKS+101) return -1; /*FLIC*/

  MMechostr(MSKTRACE,"pp : %d\n",m->pp);
  MMechostr(MSKTRACE,"debut GC : %x/%x\n",m->topheap,m->sizetape);

//  MMechostr(MSKTRACE,"GC 0\n");
  MMgcfirstSpec(m);  /* marquage des blocs */
//  MMechostr(MSKTRACE,"GC bmp\n");
  OBJfindFloatBmp(m);
//  MMechostr(MSKTRACE,"GC 1\n");

  MMgcfirst(m);  /* marquage des blocs */
//  MMechostr(MSKTRACE,"GC 2\n");

  MMgcsecond(m); /* calcul des nouvelles positions des blocs */
//  MMechostr(MSKTRACE,"GC 3\n");

  MMgcthird(m);  /* reglage des pointeurs */ 
//  MMechostr(MSKTRACE,"GC 4\n");

  MMgcfourth(m); /* deplacement des blocs */
  MMechostr(MSKTRACE,"fin GC : %x\n",m->topheap);
/*  getchar();
*/
#if defined(RELEASE_DEVELOPER)
  // Echo a timestamp followed by the call stack
  if (timestamp != -1) {
    struct tm* now = localtime(&timestamp);
    MMechostr(MSKTRACE, "@ %s", asctime(now));
  }
  MMechostr(MSKTRACE, "Call stack:\n");
  printCallStack();
  MMechostr(MSKTRACE, "***********\n");
#endif
  return 0;
}

extern int indexHard;

/*
   Initialisation d'une machine : la taille de la bande est donnee en mots
        retourne -1 si erreur, 0 si succes.
*/
int MMinimachine(mmachine m, int size)
{
  m->tape=(int*)malloc(size*SizeWord);
  if (m->tape==NULL) return -1;

  m->sizetape=m->pp=m->maxpp=size;
  m->top=&m->tape[size]; m->pp=m->maxpp=0;
//  m->top=&m->tape[0];		// PPNEG A MODIFIER POUR PASSER EN PILE NEGATIVE
  m->topheap=0;
  m->sigGC=16;
  m->err=0;
  indexHard=0;
  return 0;
}

// définition de la taille de mémoire à garder libre après une augmentation de la bande
#define MEM_MIN_TAMPON (1024*256)
// définition de la taille maximale de mémoire
int MEM_MAX_SIZE=(1024*256*64);

int MMnewSizeTape(mmachine m,int size)
{
	int news,newsize,i;
	int *newtape,*newtop;

	news=m->topheap + size + m->sigGC-m->pp+MEM_MIN_TAMPON;
	if (news<m->sizetape) return -1; // normalement impossible
	newsize=m->sizetape;
	while(newsize<news) newsize+=MEM_MIN_TAMPON;

	MMechostr(MSKTRACE,"Try malloc %x/%x\n",newsize,MEM_MAX_SIZE);
	if (newsize>MEM_MAX_SIZE) return -1; // on dépasse la limite autorisée pour une machine
	newtape=(int*)malloc(newsize*SizeWord); // nouvelle bande mémoire
	if (newtape==NULL) return -1;
	newtop=&newtape[newsize];
	for(i=0;i<m->topheap;i++) newtape[i]=m->tape[i]; // copie du tas
	for(i=m->pp;i<0;i++) newtop[i]=m->top[i]; // copie de la pile
	free((void*)m->tape);
	m->tape=newtape;
	m->top=newtop;
	m->sizetape=newsize;
	MMechostr(MSKTRACE,"Ok\n");
	return 0;
}
	
int MMneedMemory(mmachine m,int size,int realsize)
{
  if (m->pp +m->sizetape< m->topheap + realsize + m->sigGC) // PPNEG DECOMMENTER
    {
      MMgc(m);
      if (m->pp +m->sizetape< m->topheap + realsize + m->sigGC+MEM_MIN_TAMPON) // PPNEG DECOMMENTER
        {
		  if (!MMnewSizeTape(m,realsize)) return 0;
		  m->err=-1;
		  MMechostr(MSKRUNTIME,"size of required block : %d\n",size);
		  return -1;
	    }
    }
  return 0;
}

/*
   Empilement d'un nouvel objet
        retourne -1 si erreur, 0 si succes.
*/
int MMpush(mmachine m, int v)
{
  m->pp--;
  m->top[m->pp]=v;

  return MMneedMemory(m,0,0);
}

/*
   Empilement d'un nouvel objet sans GC : a utiliser avec precaution
        retourne 0
*/
int MMpushNoGC(mmachine m, int v)
{
  m->pp--;
  m->top[m->pp]=v;
  return 0;
}

/*
   Depile un objet
*/
int MMpull(mmachine m)
{
  if (m->pp>=m->maxpp) return 0;

  return m->top[m->pp++];
}

/* Lit la valeur du pointeur de pile */
int MMgetPP(mmachine m)
{
	return m->pp;
}

/* Ecrit la valeur du pointeur de pile */
void MMsetPP(mmachine m,int i)
{
	m->pp=i;
}

/*
   Lit un etage de la pile, sans le depiler
*/
int MMget(mmachine m,int i)
{
  return m->top[m->pp+i];
}

/*
   Ecrit un etage de la pile, sans le depiler
*/
void MMset(mmachine m,int i,int v)
{
  m->top[m->pp+i]=v;
}

/*
   Lit une variable globale
*/
int MMgetglobal(mmachine m,int i)
{
  return m->top[m->maxpp+i];
}

/*
   Ecrit une variable globale
*/
void MMsetglobal(mmachine m,int i,int v)
{
  m->top[m->maxpp+i]=v;
}

/*
   Lit un champ de la pile, a partir d'une base donee
*/
int MMgetbase(mmachine m,int b,int i)
{
  return m->top[b+i];
}

/*
   Ecrit un champ de la pile, a partir d'une base donnee
*/
void MMsetbase(mmachine m,int b,int i,int v)
{
  m->top[b+i]=v;
}

/*
   Lit un champ d'un bloc TAB
*/
int MMfetch(mmachine m,int s,int i)
{
  return m->tape[s+SizeHeader+i];
}

/*
   Ecrit un champ d'un bloc TAB
*/
void MMstore(mmachine m,int s,int i,int v)
{
  m->tape[s+SizeHeader+i]=v;
}

/*
   Recupere un pointeur vers le debut d'un bloc BUF
*/
int* MMstart(mmachine m,int s)
{
  return &m->tape[s+SizeHeader];
}

/*
   Donne la taille en "int" d'un bloc BUF ou TAB
*/
int MMsize(mmachine m,int s)
{
  return m->tape[s]>>1;
}

/*
   Donne le type d'un bloc BUF ou TAB -> TYPEBUF ou TYPETAB
*/
int MMtype(mmachine m,int s)
{
  return m->tape[s]&1;
}

/*
   Recupere un pointeur vers le debut d'une chaine de caracteres
*/
char* MMstartstr(mmachine m,int s)
{
  return (char*)&m->tape[s+SizeHeader+1];
}

/*
   Recupere la taille d'une chaine de caracteres
*/
int MMsizestr(mmachine m,int s)
{
  return m->tape[s+SizeHeader];
}

/*
   Regle la taille d'une chaine de caracteres
*/
void MMsetsizestr(mmachine m,int s,int size)
{
  m->tape[s+SizeHeader]=size;
}

/*
   Fonctions de transfert Objet <-> Int ou Pointer
*/
int ITOO(int i)
{
    return i+i;
}
int PTOO(int p)
{
    return p+p+1;
}
int OTOI(int i)
{
#ifdef VERSIONDEBUG
   if (i&1) MMechostr(MSKRUNTIME,"OTOI error %x\n",i);
#endif
   return i>>1;
}
int OTOP(int p)
{
#ifdef VERSIONDEBUG
   if ((p&1)==0) MMechostr(MSKRUNTIME,"OTOP error %x\n",p);
#endif
   return p>>1;
}

/*
   Alloue un bloc dans le tas : la taille est donnee en mots
    le bloc est initialise selon type
    retourne -1 si echec, sinon retourne le pointeur
*/
int MMmalloc(mmachine m, int size, int type)
{
  int realsize,pnt,k;

  realsize=size+SizeHeader;

  if (k=MMneedMemory(m,size,realsize)) return k;

  pnt=m->topheap;
  m->tape[pnt]=(size*2)|type;
  m->tape[pnt+1]=0;
  m->topheap+=realsize;

  return pnt;
}
 
/*
   Idem Malloc, avec mise a zero du bloc
    retourne -1 si echec, sinon retourne le pointeur
*/
int MMmallocCLR(mmachine m, int size, int type)
{
  int pnt,i;

  pnt=MMmalloc(m,size,type);
  if (pnt==MERRMEM) return pnt;
  for(i=0;i<size;i++) m->tape[pnt+SizeHeader+i]=0;
  return pnt;
}

int MMcore(mmachine m)
{
  FILE *f;

  f=fopen("core.mgm","wb");
  if (f==NULL) return -1;
  fwrite((char*)m,1,sizeof(struct Mmachine),f);
  fwrite((char*)m->tape,sizeof(int),m->sizetape,f);
  fclose(f);
  return 0;
}