/*     
      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 "scolPrerequisites.h"

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

#include "scolMMemory.h"
#include "common/vscol.h"
#include "common/kernel.h"
#include "vm/mbytec.h"
#include <stdio.h>
#include <assert.h>

char MMbuf[1024];

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

#define TESTSGC

int MMpc(void);


// Marquage des blocs
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;
#if SCOL_PLATFORM == SCOL_PLATFORM_WINDOWS
      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;
}


//$BLG - v5.21: Del (Unused)
/*
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;
}
*/


// Marquage des blocs (?2?)
int MMgcfirst(mmachine m)
{
  int i, k, j, n;
  int first;

  first = -1;
  //$BLG Note: Loop only once ???
  for(i = m->maxpp+3; i < m->maxpp+4; i++)
	//$BLG Note: following line has always been commented in the sources I got
	//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;
}


//Calcul des nouvelles positions des blocs
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;
}


// Réglage des pointeurs
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;
}


// Déplacement des blocs
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
*/
//$BLG Note: Found in src/kernel/scolobj.c
int OBJfindFloatBmp(mmachine m);

int OBJcountT(mmachine m,int typ);

int OBJtypebyname(char *name);

extern char stringobj[120][32];


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

int MMgc(mmachine m)
{
	//$BLG - v5.21: Add
	//int t1, t2;
	int ti = 0;

#if defined(RELEASE_DEVELOPER)
  time_t timestamp = time(NULL);
#endif
//$BLG - v5.11: Del
//maxsock is initialized as MAXSOCKS and never modified (cf testLicence in scolsys.cpp)
//except in case of ReduceCapacity (but this reduces the value so ...)
//if (maxsock+101>MAXSOCKS+101) return -1; /*FLIC*/
	
	//$BLG - v5.21: Add
	//t1 = GetTickCount();
	
	//$BLG note: Duration of a GC - from <15ms to <90ms on tested sites (Loft, Village, Showroom)
	
  MMechostr(MSKTRACE, "\npp : %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");
  
  //$BB debug obj destruction
#if defined(SCOL_DEBUG)
  MMechostr(MSKDEBUG, "GC nb scol obj start \n");
  for(ti = 0; ti < 120; ti++)
  {
     char * objname = stringobj[ti];
     int objtype = OBJtypebyname(objname);
     MMechostr(MSKDEBUG, "GC nb scol obj %s : %i\n", objname, OBJcountT(m, objtype));
  }
  MMechostr(MSKDEBUG, "GC nb scol obj end \n");
#endif

  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
	
	//$BLG - v5.21: Add
	//t2 = GetTickCount();
	//MMechostr(0,"$BLG - MMgc: %dms\n", (t2-t1));

  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;
	
	//$BLG - v5.21: Add
	//int t1, t2;

	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,"\nTry 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];
	
	//$BLG - v5.21: Add
	//t1 = GetTickCount();
	
	//$BLG note: this operation isn't time consuming ... <15ms for 15MB ...
	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
	
	//$BLG - v5.21: Add
	//t2 = GetTickCount();
	//MMechostr(0,"$BLG - MMnewSizeTape: %dB %dMB %dms\n", newsize, newsize/(1024*256), (t2-t1));
	
	free((void*)m->tape);
	m->tape=newtape;
	m->top=newtop;
	m->sizetape=newsize;
	MMechostr(MSKTRACE,"Ok\n\n");
	return 0;
}
	
int MMneedMemory(mmachine m,int size,int realsize)
{
  //MMechostr(0,"MMneedMemory\n");
  if (m->pp +m->sizetape< m->topheap + realsize + m->sigGC) // PPNEG DECOMMENTER
    {
      //MMechostr(0,"MMgc\n");
      //$BLG - v5.22: Modif
      //MMgc(m);
      if (!m->lckdGC)
      	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)
{
  int ret;

  //MMechostr(0,"> MMpush\n");
  m->pp--;
  m->top[m->pp]=v;

	//MMechostr(0,"< MMpush: %d %d\n", m->pp, v);
  
  ret = MMneedMemory(m,0,0);
  return ret; 
}

/*
   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;
 
  //MMechostr(0,">  MMpushNoGC: %d %d\n", m->pp, v);
 
  return 0;
}

/*
   Depile un objet
*/
int MMpull(mmachine m)
{
  int ret;
	//MMechostr(0, "> MMpull\n");
	
  if (m->pp>=m->maxpp) return 0;
  
  //MMechostr(0,"< MMpull: %d %d\n", m->pp, m->top[m->pp]);
  ret = m->top[m->pp++];
  return ret;
}

/* 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)
{
  int ret;
  
  //MMechostr(0,"< MMpull: %d %d\n", m->pp, m->top[m->pp]);
  ret = m->top[m->pp+i];
  return ret;
}

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

/*
   Lit une variable globale
*/
int MMgetglobal(mmachine m,int i)
{
  //MMechostr(0, "> MMgetglobal: %d\n", m->top[m->maxpp+i]);
  return m->top[m->maxpp+i];
}

/*
   Ecrit une variable globale
*/
void MMsetglobal(mmachine m,int i,int v)
{
	//MMechostr(0, "> MMsetglobal: %d %d\n", m->top[m->maxpp+i], 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)
{
#ifdef SCOL_DUMP_CORE
      if ((s < 0) || (s >= m->sizetape))
      {
        MMechostr(MSKRUNTIME, "bad pointer MMfetch: %i on tape size %i\n", s, m->sizetape);
         MMcore(m);
      }
#endif
  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;
}