//
// Load 'scolbase' package
//
// ER   10/07/2001   Put the declaration of maxsock in comment, its declaration is done in vscol.h
// FA   13/07/2001   Use a2f() and f2a() utility functions (lexer.h)
// FA   18/07/2001   Library function 'rand' corrected: interval fixed to [0..32767]. Function 'abs'
//                   optimised
// FA   19/07/2001   Word and line processing functions moved here
// FA   20/07/2001   Functions MBhtoi() and MBatoi() rewritten. Function MBabsf() corrected (it
//                   returned garbage if argument was nil)
// FA   27/07/2001   Add _funlist and _CtoScol undocumented functions
// FA   18/03/2002   Accept redundant base specifier "0x" in MBhtoi()
// FA   16/05/2002   Modify MBcom2() and MBcomv2() to return an empty message when the internal buffer overflows
//                   The predicate _isCommTooBig allows the user to test this case
//
// $LB (07/06/2004) :
// add strcpy function : fun [S    I      I]      S
//                            src  first  size    dst
//
// $LB (08/06/2004) :
// add memcpy function : fun [S    I        S      I       I]      I
//                            dst  offset   src    offset  size    return code

//$JI - julia.interactive@wanadoo.fr
//$JI     16/11/2005      New functions: MBf2a5d(), MBf2a4d(), MBf2a3d(), MBf2a2d() & MBf2a1d()

//$BLG - http://www.kyrien.com
//$BLG    17/11/2005      Fixed MBnth_char()
//$BLG    05/01/2005      Fixed MBf2a5d(), MBf2a4d(), MBf2a3d(), MBf2a2d() & MBf2a1d()

// Generic header
#include "scolPrerequisites.h"
#include "scolTypeConversion.h"
#include "base.h"
#include "baselib.h"
#include "compiler/lexer.h"
#include "scolMacros.h"
#include "vm/interp.h"
#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>

extern "C" 
{
#include "common/vscol.h"     // declaration of MAXSOCKS
#include "blg_memory.h"
#include "scolMMemory.h"
#include "mzip.h"
#include "loadpak.h"
#include "listlab.h"           // declaration of Mpushstrbloc()
#include "md5.h"
}


#if SCOL_PLATFORM == SCOL_PLATFORM_WINDOWS
// This should be done properly
# define strcasecmp  _stricmp
# define strncasecmp _strnicmp
#endif


// 31-bit integer library functions
static int MBrand(mmachine m);
static int MBsrand(mmachine m);
static int MBmax(mmachine m);
static int MBmin(mmachine m);
static int MBabs(mmachine m);
static int MBitoa(mmachine m);
static int MBitoh(mmachine m);

// 31-bit floating point library functions
const float pi = 3.141593f;
const float e  = 2.718282f;

static int MBftoa(mmachine m);
//$JI - Start - v4.6a4 - New F type display functions
static int MBftoa5d(mmachine m);
static int MBftoa4d(mmachine m);
static int MBftoa3d(mmachine m);
static int MBftoa2d(mmachine m);
static int MBftoa1d(mmachine m);
//$JI - End
static int MBabsf(mmachine m);
static int MBPIf(mmachine m);
static int MBcos(mmachine m);
static int MBsin(mmachine m);
static int MBtan(mmachine m);
static int MBacos(mmachine m);
static int MBasin(mmachine m);
static int MBatan(mmachine m);
static int MBatan2(mmachine m);
static int MBEf(mmachine m);
static int MBlog(mmachine m);
static int MBlog10(mmachine m);
static int MBexp(mmachine m);
static int MBpow(mmachine m);
static int MBsqr(mmachine m);
static int MBsqrt(mmachine m);
static int MBrootn(mmachine m);
//$BLG - v5.11: Add
static int MBminf(mmachine m);
static int MBmaxf(mmachine m);

// List <=> Array conversion functions
static int MBtabtolist(mmachine m);
static int MBtabtolistR(mmachine m);
static int MBlisttotab(mmachine m);
static int MBlisttotabR(mmachine m);

// String management functions
static int MBatoi(mmachine m);
static int MBatof(mmachine m);
static int MBhtoi(mmachine m);
static int MBstrlen(mmachine m);
static int MBstrcmp(mmachine m);
static int MBstrfind(mmachine m);
static int MBstrfindi(mmachine m);
static int MBlisttostr(mmachine m);
static int MBstrtolist(mmachine m);
static int MBnth_char(mmachine m);
static int MBset_nth_char(mmachine m);
static int MBctoa(mmachine m);
static int MBmkscript(mmachine m);
static int MBstrlowercase(mmachine m);
static int MBstruppercase(mmachine m);
static int MBstrcmpi(mmachine m);
int MBstrcat(mmachine m);
int MBstrcatn(mmachine m);
int MBcom(mmachine m);
int MBcomv(mmachine m);
int MBsubstr(mmachine m);
int MBstrdup(mmachine m);
//$BLG - v5.11: Add
int MBstrcatinit(mmachine m);
int MBstrcatblit(mmachine m);
int MBstrcatlen(mmachine m);
//$BLG - v5.24: Add
int MBstrmd5(mmachine m);
//$BLG - v5.2.06: Add
int MBstrtrim(mmachine m);
//$BLG - v5.3.01: Add
int MBlgetinfo(mmachine m);
int MBlgetinfoi(mmachine m);
int MBlgetinfos(mmachine m);
int MBlcat(mmachine m);

// List management and miscellaneous
static int MBstrextr(mmachine m);
static int MBstrbuild(mmachine m);
static int MBstrbuild2(mmachine m);
static int MBlineextr(mmachine m);
static int MBlinebuild(mmachine m);
static int MBlinebuild2(mmachine m);
static int MBtime(mmachine m);
static int MBctime(mmachine m);
static int MBgmtime(mmachine m);
static int MBlocaltime(mmachine m);
static int MBhd(mmachine m);
int MBtl(mmachine m);
static int MBsizelist(mmachine m);
static int MBnth_list(mmachine m);
static int MBendlist(mmachine m);
int MBstrtoweb(mmachine m);
int MBwebtostr(mmachine m);
int MButf8tostr(mmachine m);
int MBstrtoutf8(mmachine m);

char *MBcopyword(char *cr,int *deb);


//
// 31-bit integer library functions ********************************************
//


static int MBrand(mmachine m)
// Returns a random integer in the interval [0..32767]
{
#if RAND_MAX == 32767
  return SEPUSH(m, SEI2W(rand()));
#else
// This function is effectively slower in platforms where RAND_MAX
// does not equal 32767
  return SEPUSH(m, SEI2W(rand()&0x7fff));
#endif
}


static int MBsrand(mmachine m)
// (S) Sets the seed for the random generator. Returns 0
// [0] integer seed
{
  SEWORD seed = m->top[m->pp];
  if (seed == NIL)
    return MERROK;
  srand(SEW2I(seed));
  m->top[m->pp] = SEI2W(0);
  return MERROK;
}


static int MBmax(mmachine m)
// (S) Returns the greatest between two integer values
// [1] integer value #0
// [0] integer value #1
{
  SEWORD val1 = m->top[m->pp++];
  SEWORD val0 = m->top[m->pp];
  if (val0 == NIL || val1 == NIL) {
    m->top[m->pp] = NIL;
    return MERROK;
  }
  m->top[m->pp] = (val0 > val1) ? val0 : val1;
  return MERROK;
}


static int MBmin(mmachine m)
// (S) Returns the smallest between two integer values
// [1] integer value #0
// [0] integer value #1
{
  SEWORD val1 = m->top[m->pp++];
  SEWORD val0 = m->top[m->pp];
  if (val0 == NIL || val1 == NIL) {
    m->top[m->pp] = NIL;
    return MERROK;
  }
  m->top[m->pp] = (val0 < val1) ? val0 : val1;
  return MERROK;
}


static int MBabs(mmachine m)
// (S) Returns the absolute value of an integer value
// [0] integer value
{
  SEWORD val = m->top[m->pp];
  if (val >= 0 || val == NIL)
    return MERROK;
  m->top[m->pp] = -val;
  return MERROK;
}


static int MBitoa(mmachine m)
// (S) Returns the string representation of an integer value
// [0] integer value
{
  SEWORD val = m->top[m->pp];
  if (val == NIL)
    return MERROK;
  char s[32];
  i2a(SEW2I(val), s);
  m->pp++;
  return SEPUSHSTR(m, s);
}


static int MBitoh(mmachine m)
// (S) Returns the hex string representation of an integer value
// [0] integer value
{
  SEWORD val = m->top[m->pp];
  if (val == NIL)
    return MERROK;
  char s[32];
  i2h(SEW2I(val), s);
  m->pp++;
  return SEPUSHSTR(m, s);
}


// 
// 31-bit floating point library functions *************************************
//


static int MBftoa(mmachine m)
// (S) Converts a float value into its string representation
// [0] float value
{
  SEWORD val = m->top[m->pp];
  if (val == NIL) 
    return MERROK;
  char s[64];
  if (!f2a(FGET(val), s))                                //$ FA(13/07/2001)
    s[0] = '\0';
  m->pp++;
  return SEPUSHSTR(m, s);
}


//$JI - Start - v4.6a4 - New F type diplay functions
static int MBftoa5d(mmachine m)
{
  SEWORD val = m->top[m->pp];
  if (val == NIL) 
    return MERROK;
  char s[64];
  //$BLG - Modif
  /*
  if (!f2a5d(FGET(val), s))
    s[0] = '\0';
  */
  if (!f2a(FGET(val), s))
    s[0] = '\0';
  else
    s[strlen(s)-1] = '\0';
  m->pp++;
  return SEPUSHSTR(m, s);
}
static int MBftoa4d(mmachine m)
{
  SEWORD val = m->top[m->pp];
  if (val == NIL) 
    return MERROK;
  char s[64];
  //$BLG - Modif
  /*
  if (!f2a4d(FGET(val), s))
    s[0] = '\0';
  */
  if (!f2a(FGET(val), s))
    s[0] = '\0';
  else
    s[strlen(s)-2] = '\0';
  m->pp++;
  return SEPUSHSTR(m, s);
}
static int MBftoa3d(mmachine m)
{
  SEWORD val = m->top[m->pp];
  if (val == NIL) 
    return MERROK;
  char s[64];
  //$BLG - Modif
  /*
  if (!f2a3d(FGET(val), s))
    s[0] = '\0';
  */
  if (!f2a(FGET(val), s))
    s[0] = '\0';
  else
    s[strlen(s)-3] = '\0';
  m->pp++;
  return SEPUSHSTR(m, s);
}
static int MBftoa2d(mmachine m)
{
  SEWORD val = m->top[m->pp];
  if (val == NIL) 
    return MERROK;
  char s[64];
  //$BLG - Modif
  /*
  if (!f2a2d(FGET(val), s))
    s[0] = '\0';
  */
  if (!f2a(FGET(val), s))
    s[0] = '\0';
  else
    s[strlen(s)-4] = '\0';
  m->pp++;
  return SEPUSHSTR(m, s);
}
static int MBftoa1d(mmachine m)
{
  SEWORD val = m->top[m->pp];
  if (val == NIL) 
    return MERROK;
  char s[64];
  //$BLG - Modif
  /*
  if (!f2a1d(FGET(val), s))
    s[0] = '\0';
  */
  if (!f2a(FGET(val), s))
    s[0] = '\0';
  else
    s[strlen(s)-5] = '\0';
  m->pp++;
  return SEPUSHSTR(m, s);
}
//$JI - End


static int MBabsf(mmachine m)
// (S) Returns the absolute value of a float value
// [0] float value
{
  SEWORD val = m->top[m->pp];
  if (val == NIL)
    return MERROK;
  FSET(m->top[m->pp], (float)fabs(FGET(val)))
  return MERROK;
}


static int MBPIf(mmachine m)
// Returns the constant pi
{
  SEWORD val;
  FSET(val, pi)
  return SEPUSH(m, val);
}


static int MBcos(mmachine m)
// (S) Returns the value of cos(val)
// [0] float value
{
  SEWORD val = m->top[m->pp];
  if (val == NIL) 
    return MERROK;
  FSET(m->top[m->pp], (float)cos(FGET(val)))
  return MERROK;
}


static int MBsin(mmachine m)
// (S) Returns the value of sin(val)
// [0] float value
{
  int val = m->top[m->pp];
  if (val == NIL) 
    return MERROK;
  FSET(m->top[m->pp], (float)sin(FGET(val)))
  return MERROK;
}


static int MBtan(mmachine m)
// (S) Returns the value of tan(val)
// [0] float value
{
  SEWORD val = m->top[m->pp];
  if (val == NIL) 
    return MERROK;
  FSET(m->top[m->pp], (float)tan(FGET(val)))
  return MERROK;
}


static int MBacos(mmachine m)
// (S) Returns the value of acos(val)
// [0] float value
{
  SEWORD val = m->top[m->pp];
  if (val == NIL) 
    return MERROK;
  FSET(m->top[m->pp], (float)acos(FGET(val)))
  return MERROK;
}


static int MBasin(mmachine m)
// (S) Returns the value of asin(val)
// [0] float value
{
  SEWORD val = m->top[m->pp];
  if (val == NIL) 
    return MERROK;
  FSET(m->top[m->pp], (float)asin(FGET(val)))
  return MERROK;
}


static int MBatan(mmachine m)
// (S) Returns the value of atan(val)
// [0] float value
{
  SEWORD val = m->top[m->pp];
  if (val == NIL) 
    return MERROK;
  FSET(m->top[m->pp], (float)atan(FGET(val)))
  return MERROK;
}


static int MBatan2(mmachine m)
// (S) Returns the value of atan2(val)
// [0] float value
{
  SEWORD val1 = m->top[m->pp++];
  SEWORD val0 = m->top[m->pp];
  if (val0 == NIL || val1 == NIL) {
    m->top[m->pp] = NIL;
    return MERROK;
  }
  FSET(m->top[m->pp], (float)atan2(FGET(val1), FGET(val0)))
  return MERROK;
}


static int MBEf(mmachine m)
// Returns the constant value e
{
  SEWORD val;
  FSET(val, e)
  return SEPUSH(m, val);
}


static int MBlog(mmachine m)
// (S) Returns the value of ln(val)
// [0] float value
{
  SEWORD val = m->top[m->pp];
  if (val == NIL) 
    return MERROK;
  FSET(m->top[m->pp], (float)log(FGET(val)))
  return MERROK;
}


static int MBlog10(mmachine m)
// (S) Returns the value of log(val)
// [0] float value
{
  SEWORD val = m->top[m->pp];
  if (val == NIL) 
    return MERROK;
  FSET(m->top[m->pp], (float)log10(FGET(val)))
  return 0;
}


static int MBexp(mmachine m)
// (S) Returns the value of e^val
// [0] float value
{
  SEWORD val = m->top[m->pp];
  if (val == NIL) 
    return MERROK;
  FSET(m->top[m->pp], (float)exp(FGET(val)))
  return MERROK;
}


static int MBpow(mmachine m)
// (S) Returns the value of val0^val1
// [1] float value #0
// [0] float value #1
{
  SEWORD val1 = m->top[m->pp++];
  SEWORD val0 = m->top[m->pp];
  if (val0 == NIL || val1 == NIL) {
    m->top[m->pp] = NIL;
    return MERROK;
  }
  FSET(m->top[m->pp], (float)pow(FGET(val0), FGET(val1)))
  return MERROK;
}


static int MBsqr(mmachine m)
// (S) Returns the value of val^2
// [0] float value
{
  SEWORD val = m->top[m->pp];
  if (val == NIL) 
    return MERROK;
  float f = FGET(val);
  FSET(m->top[m->pp], f*f)
  return MERROK;
}


static int MBsqrt(mmachine m)
// (S) Returns the value of val^(1/2)
// [0] float value
{
  SEWORD val = m->top[m->pp];
  if (val == NIL) 
    return MERROK;
  FSET(m->top[m->pp], (float)sqrt(FGET(val)))
  return MERROK;
}


static int MBrootn(mmachine m)
// (S) Returns the value of val0^(1/val1)
// [1] float value #0
// [0] float value #1
{
  SEWORD val1 = m->top[m->pp++];
  SEWORD val0 = m->top[m->pp];
  if (val0 == NIL || val1 == NIL) {
    m->top[m->pp] = NIL;
    return MERROK;
  }
  FSET(m->top[m->pp], (float)pow(FGET(val0), 1/FGET(val1)))
  return MERROK;
}


//$BLG - v5.11: Add
static int MBmaxf(mmachine m)
// (S) Returns the greatest between two float values
// [1] float value #0
// [0] float value #1
{
  SEWORD val1 = m->top[m->pp++];
  SEWORD val0 = m->top[m->pp];
  if (val0 == NIL || val1 == NIL) 
  {
    m->top[m->pp] = NIL;
    return MERROK;
  }
  FSET(m->top[m->pp], (FGET(val0) > FGET(val1)) ? FGET(val0) : FGET(val1));
  return MERROK;
}


//$BLG - v5.11: Add
static int MBminf(mmachine m)
// (S) Returns the smallest between two float values
// [1] float value #0
// [0] float value #1
{
  SEWORD val1 = m->top[m->pp++];
  SEWORD val0 = m->top[m->pp];
  if (val0 == NIL || val1 == NIL) 
  {
    m->top[m->pp] = NIL;
    return MERROK;
  }
  FSET(m->top[m->pp], (FGET(val0) < FGET(val1)) ? FGET(val0) : FGET(val1));
  return MERROK;
}


//
// List <=> Array conversion functions *****************************************
//

static int MBtabtolist(mmachine m)
{
	int i,k,s,p,pp;

	p=MMget(m,0);
	if (p==NIL) return 0;
	s=MMsize(m,p>>1);
	pp=MMgetPP(m);
	for(i=0;i<s;i++) if (MMpush(m,MMfetch(m,MMgetbase(m,pp,0)>>1,i))) return MERRMEM;
	if (MMpush(m,NIL)) return MERRMEM;
	for(i=0;i<s;i++)
	{
		if (MMpush(m,2<<1)) return MERRMEM;
		if (k=MBdeftab(m)) return k;
	}
	MMset(m,1,MMget(m,0));
	MMpull(m);
	return 0;
}


static int MBtabtolistR(mmachine m)
{
	int i,k,s,p,pp;

	p=MMget(m,0);
	if (p==NIL) return 0;
	s=MMsize(m,p>>1);
	pp=MMgetPP(m);
	for(i=0;i<s;i++) if (MMpush(m,MMfetch(m,MMgetbase(m,pp,0)>>1,s-1-i))) return MERRMEM;
	if (MMpush(m,NIL)) return MERRMEM;
	for(i=0;i<s;i++)
	{
		if (MMpush(m,2<<1)) return MERRMEM;
		if (k=MBdeftab(m)) return k;
	}
	MMset(m,1,MMget(m,0));
	MMpull(m);
	return 0;
}

static int MBlisttotab(mmachine m)
{
	int n,i,s,p;

	n=0;
	p=MMget(m,0)>>1;
	while(p!=NIL)
	{
		p=MMfetch(m,p,OFFLNEXT)>>1;
		n++;
	}
  
  s=MMmalloc(m,n,TYPETAB); if (s==NIL) return MERRMEM;

	p=MMget(m,0)>>1;
	for(i=0;i<n;i++)
	{
		MMstore(m,s,i,MMfetch(m,p,OFFLVAL));
		p=MMfetch(m,p,OFFLNEXT)>>1;
	}
	MMset(m,0,s+s+1);
	return 0;
}

static int MBlisttotabR(mmachine m)
{
	int n,i,s,p;

	n=0;
	p=MMget(m,0)>>1;
	while(p!=NIL)
	{
		p=MMfetch(m,p,OFFLNEXT)>>1;
		n++;
	}
  
  s=MMmalloc(m,n,TYPETAB); if (s==NIL) return MERRMEM;

	p=MMget(m,0)>>1;
	for(i=0;i<n;i++)
	{
		MMstore(m,s,n-1-i,MMfetch(m,p,OFFLVAL));
		p=MMfetch(m,p,OFFLNEXT)>>1;
	}
	MMset(m,0,s+s+1);
	return 0;
}


//
// String management functions *************************************************
//


static int MBatoi(mmachine m)
// (S) Converts a string into an integer value
// [0] string
{
  SEWORD str = m->top[m->pp];
  if (str == NIL)
    return MERROK;
  SEINT i;
  // It should return nil in case of error instead of 0
  a2i10((char*)&m->tape[(str>>1)+SizeHeader+1], &i);
  m->top[m->pp] = SEI2W(i);
  return MERROK;
}


static int MBatof(mmachine m)
// Converts a string into a float value
// [0] string
{
  int str = m->top[m->pp];
  if (str == NIL)
  {
    //MMechostr(MSKDEBUG, "ATOF NIL\n");
    return MERROK;
  }
  float f=0.0f;
  char* sfloat = (char*)&m->tape[(str>>1)+SizeHeader+1];

  // It should return nil in case of error instead of 0.0
  a2f(sfloat, &f);

  FSET(m->top[m->pp], f)

  float x = FGET(m->top[m->pp]);
  //$BB test for Not a Number
  if ((x) != (x))
  {
    m->top[m->pp]=NIL;
    MMechostr(MSKDEBUG, "ATOF NAND value : %s float : %f\n", sfloat, x);
    return MERROK;
  }
  //MMechostr(MSKDEBUG, "ATOF value : %s float : %f\n", sfloat, x);
  return MERROK;
}


static int MBhtoi(mmachine m)
// Converts an hex string into an integer value
// [0] string
{
  SEWORD str = m->top[m->pp];
  if (str == NIL)
    return MERROK;
  SEINT i;
  // This is not consistent with MBatof() and MBatoi()
  char* s = (char*)&m->tape[(str>>1)+SizeHeader+1];
// FA(18/03/2002): Accept redundant base specifier "0x"
  if (s[0] == '0' && (s[1] == 'x' || s[1] == 'X'))
    s += 2;
  h2i(s, &i);
  m->top[m->pp] = SEI2W(i);
  return MERROK;
}


int myhtoi(char* s)
//$ FA(20/07/2001): Wrapper around h2i(). Deprecated
{
  int i;
  h2i(s, &i);
  return i;
}


static int MBstrlen(mmachine m)
{
  int p;

  p=m->top[m->pp];
  if (p==NIL) return 0;
  m->top[m->pp]=m->tape[(p>>1)+SizeHeader]*2;
  return 0;
}


//$BLG - v5.11: Del
//cf note at beginning of file
//extern int maxsock; /*FLIC*/

int MBstrcat(mmachine m)
{
  int p,q,l,np,nq,s;
  char *cp,*cq,*cr;

	//$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+10>MAXSOCKS+10) return -1; /*FLIC*/

  q=m->top[m->pp];
  p=m->top[m->pp+1];
  if (p==NIL)
  {
	  m->top[m->pp+1]=q;
	  m->pp++;
	  return MBstrdup(m);
  }
  if (q==NIL)
  {
	  m->pp++;
	  return MBstrdup(m);
  }

  np=m->tape[(p>>1)+SizeHeader];
  nq=m->tape[(q>>1)+SizeHeader];
  l=(np+nq+4)>>2;
  s=MMmalloc(m,l+1,TYPEBUF); if (s==NIL) return MERRMEM;
  m->tape[s+SizeHeader]=np+nq;

  q=MMpull(m);
  p=m->top[m->pp];
  cp=(char*)&m->tape[(p>>1)+SizeHeader+1];
  cq=(char*)&m->tape[(q>>1)+SizeHeader+1];
  cr=(char*)&m->tape[s+SizeHeader+1];
  //$BLG - v5.11: Modif
  //memcpy((void*)cr,(void*)cp,np);
  BLG_memcpy8((void *)cr, (void *)cp, np);
  //$BLG - v5.11: Modif
  //memcpy((void*)(cr+np),(void*)cq,nq);
  BLG_memcpy8((void *)(cr+np), (void *)cq, nq);
  cr[np+nq]=0;

  m->top[m->pp]=s+s+1;
  return 0;
}


static int MBstrcmp(mmachine m)
{
  int p,q;
  char *cp,*cq;

  q=MMpull(m);
  p=MMget(m, 0);
  if ((p==NIL) || (q==NIL))
  {
    if ((p==NIL) && (q==NIL))
      MMset(m, 0, ITOM(0));
    else if (p!=NIL)
      MMset(m, 0, ITOM(1));
    else
      MMset(m, 0, ITOM(-1));
    return 0;
  }
  cp=MMstartstr(m, MTOP(p));
  cq=MMstartstr(m, MTOP(q));
  MMset(m, 0, ITOM(strcmp(cp,cq)));
  return 0;
}


static int MBstrfind(mmachine m)
{
  int p,q,i0,i,l,n;
  char *cp,*cq;

  i0=MTOI(MMpull(m));
  q=MMpull(m);
  p=MMget(m, 0);
  if ((p==NIL)||(q==NIL)||(i0<0))
  {
	  MMset(m, 0, NIL);
	  return 0;
  }
  cp = MMstartstr(m, MTOP(p));
  cq = MMstartstr(m, MTOP(q));

  n = MMsizestr(m, MTOP(p));
  l = MMsizestr(m, MTOP(q));
  for(i=i0;i<=l-n;i++)
  {
	  if (!memcmp(cp,cq+i,n))
	  {
		  MMset(m, 0, ITOM(i));
		  return 0;
	  }
  }
  MMset(m, 0, NIL);
  return 0;
}


static int MBstrfindi(mmachine m)
{
  int p,q,i0,i,l,n;
  char *cp,*cq;

  i0=MTOI(MMpull(m));
  q=MMpull(m);
  p=MMget(m, 0);
  if ((p==NIL)||(q==NIL)||(i0<0))
  {
	  MMset(m, 0, NIL);
	  return 0;
  }
  cp = MMstartstr(m, MTOP(p));
  cq = MMstartstr(m, MTOP(q));

  n = MMsizestr(m, MTOP(p));
  l = MMsizestr(m, MTOP(q));
  for(i=i0;i<=l-n;i++)
  {
	  if (!strncasecmp(cp,cq+i,n))
	  {
		  MMset(m, 0, ITOM(i));
		  return 0;
	  }
  }
  MMset(m, 0, NIL);

  return 0;
}


static int MBlisttostr(mmachine m)
{
  int j,l,s,p,sl;
  char *cr;

  l=0;
  p=m->top[m->pp];
  while(p!=NIL)
  {
    l++;
    p=m->tape[(p>>1)+SizeHeader+OFFLNEXT];
  }
  sl=(l+4)>>2;
  s=MMmalloc(m,sl+1,TYPEBUF); if (s==NIL) return MERRMEM;
  m->tape[s+SizeHeader]=l;
  cr=(char*)&m->tape[s+SizeHeader+1];
  p=m->top[m->pp];
  while(p!=NIL)
  {
    p>>=1;
    j=(m->tape[p+SizeHeader+OFFLVAL]>>1);
    *(cr++)=j;
    p=m->tape[p+SizeHeader+OFFLNEXT];
  }
  *cr=0;

  m->top[m->pp]=s+s+1;
  return 0;
}


static int MBstrtolist(mmachine m)
{
  int p,l,i,k,ind;
  char *s;

  ind=m->pp;
  p=m->top[ind];
  if (p==NIL) return 0;

  l=m->tape[(p>>1)+SizeHeader];
  for(i=0;i<l;i++) if (MMpush(m,0)) return MERRMEM;

  p=m->top[ind]>>1;
  s=(char*)&m->tape[p+SizeHeader+1];
  for(i=0;i<l;i++) m->top[ind-i-1]=(s[i]&255)*2;
  
  if (MMpush(m,NIL)) return MERRMEM;
  for(i=0;i<l;i++)
  {
    if (MMpush(m,2*2)) return MERRMEM;
    if (k=MBdeftab(m)) return k;
  }
  m->top[ind]=m->top[m->pp];
  m->pp=ind;
  return 0;
}


int MBsubstr(mmachine m)
{
  int p, l, s, a, b;
  char *cp, *cr;

  b = MMpull(m);
  a = MMpull(m);
  p = m->top[m->pp];
  if ((p == NIL) || (a == NIL) || (b == NIL))
  {
    m->top[m->pp] = NIL;
    return 0;
  }
  
  b >>= 1;
  a >>= 1;
  b += a;
  p >>= 1;
  l = m->tape[p+SizeHeader];
  cp = (char*)&m->tape[p+SizeHeader+1];
  if (a < 0) a = 0;
  if (b > l) b = l;
  b -= a;
  if (b < 0) b = 0;

  l = (b+4)>>2;
  s = MMmalloc(m, l+1, TYPEBUF); 
  if (s == NIL) return MERRMEM;

  m->tape[s+SizeHeader] = b;
  cr = (char*)&m->tape[s+SizeHeader+1];
  if (b)
  {
    p = m->top[m->pp];
    cp = (char*)&m->tape[(p>>1)+SizeHeader+1];
    //$BLG - v5.11: Modif
    //memcpy((void*)cr,(void*)(cp+a),b);
    BLG_memcpy8((void *)cr, (void *)(cp+a), b);
  }

  cr[b] = 0;
    
  m->top[m->pp] = s + s + 1;
  return 0;
}



// $LB (07/06/2004) :
// add strcpy function : fun [S    I      I]      S
//                            src  first  size    dst
//
// <=> it's like 'substr' but cuts the '\0' characters
//
int MBstrcpy (mmachine m)
{
	int psrc, pdst, l, ml;
	char* src;
	char* dst;
	char* check;
	int first, size, i;

  size  = MMpull(m);
  first = MMpull(m);
  psrc  = MMpull(m);

  if ((size==NIL) || (first==NIL) || (psrc==NIL))
  {
    MMechostr(0, "\nstrcpy error : one of the arguments is nil!\n");
    return MMpush(m, NIL);
  }

  size>>=1; first>>=1; psrc>>=1;


  // get the source string pointers 
  src = MMstartstr (m, psrc);

  // we don't want to copy the '\0' characters, if any...
  check = (char*) (src + first);
  i=0;
  while ((i<size) && (*(check+i) != 0))	i++;
  //update the size
  size = i;

  l    = size;
  ml   = (l+4)>>2;
  // alloc. memory for copy
  pdst = MMmalloc (m, ml+1, TYPEBUF); if (pdst==NIL) return MERRMEM;
  MMsetsizestr(m, pdst, size);

  // get the destination string pointers 
  dst = MMstartstr (m, pdst);

  // copy part of string
  //$BLG - v5.11: Modif
  //memcpy ((void*)dst, (void*)(src+first), size);
  BLG_memcpy8((void *)dst, (void *)(src+first), size);
  dst[size] = '\0';

  return MMpush (m, (pdst<<1)+1);
}


// $LB (08/06/2004) :
// add memcpy function : fun [S    I        S      I       I]      I
//                            dst  offset   src    offset  size    return code
//
// copy a part of a string directly into another
// return the number of bytes copyied
//
int MBmemcpy (mmachine m)
{
	int psrc, pdst;
	char* src;
	char* dst;
	int offsrc, offdst, size, sizesrc, sizedst;

  size   = MMpull(m);
  offsrc = MMpull(m);
  psrc   = MMpull(m);
  offdst = MMpull(m);
  pdst   = MMpull(m);


  if ((size==NIL) || (offsrc==NIL) || (psrc==NIL) || (offdst==NIL) || (pdst==NIL)) 
	  { MMechostr(0, "\nmemcpy error : one of the arguments is nil!\n"); return MMpush(m, NIL); }

  size>>=1; offsrc>>=1; psrc>>=1; offdst>>=1; pdst>>=1;

  // get the  string pointers 
  src     = MMstartstr (m, psrc);
  sizesrc = MMsizestr (m, psrc);
  dst     = MMstartstr (m, pdst);
  sizedst = MMsizestr (m, pdst);

  // check if size values are ok
  if (offsrc+size > sizesrc) size = sizesrc-offsrc;
  if (offdst+size > sizedst) size = sizedst-offdst;

  // memory copy 
  //$BLG - v5.11: Modif
  //memcpy ((void*)(dst+offdst), (void*)(src+offsrc), size);
  BLG_memcpy8((void*)(dst+offdst), (void*)(src+offsrc), size);
  
  return MMpush (m, size<<1);
}


int MBstrdup(mmachine m)
{
  int p,l,s,sl;
  char *cp,*cr;

  p=m->top[m->pp];
  if (p==NIL) return 0;
  p>>=1;
  l=m->tape[p+SizeHeader];
  sl=(l+4)>>2;
  s=MMmalloc(m,sl+1,TYPEBUF); if (s==NIL) return MERRMEM;

  m->tape[s+SizeHeader]=l;
  cr=(char*)&m->tape[s+SizeHeader+1];
  p=m->top[m->pp];
  cp=(char*)&m->tape[(p>>1)+SizeHeader+1];
  //$BLG - v5.11: Modif
  //memcpy((void*)cr,(void*)cp,l);
  BLG_memcpy8((void *)cr, (void *)cp, l);
  cr[l]=0;

  m->top[m->pp]=s+s+1;
  return 0;
}


static int MBnth_char(mmachine m)
{
  int p,l,a;
  char *cp;

  a = MMpull(m);
  p = MMget(m, 0);
  if ((p==NIL) || (a==NIL))
  {
    MMset(m, 0, NIL);
    return 0;
  }
  a = MTOI(a);
  l = MMsizestr(m, MTOP(p));
  cp = MMstartstr(m, MTOP(p));

  if ((a<0)||(a>=l))
    MMset(m, 0, 0);
  //$BLG - Modif - v4.6a4
  //else m->top[m->pp]=cp[a]*2;
  else
    MMset(m, 0, ITOM(cp[a]&0xff));
  return 0;
}


static int MBset_nth_char(mmachine m)
{
  int p,l,a,c;
  char *cp;

  c=MMpull(m)>>1;
  a=MMpull(m)>>1;
  p=m->top[m->pp];
  if ((p==NIL)||(a==NIL)||(c==NIL))
    {
      m->top[m->pp]=NIL;
      return 0;
    }
  p>>=1;
  l=m->tape[p+SizeHeader];
  cp=(char*)&m->tape[p+SizeHeader+1];
  if ((a>=0)&&(a<l)) cp[a]=c;
  return 0;
}


int MBstrcatn(mmachine m)
{
  int p,q,l,n,nq,s;
  char *cq,*cr;

  n=0;
  p=m->top[m->pp]>>1;
  while(p!=NIL)
  {
    q=m->tape[p+SizeHeader+OFFLVAL]>>1;
    if (q!=NIL) n+=m->tape[q+SizeHeader];
    p=m->tape[p+SizeHeader+OFFLNEXT]>>1;
  }
  
  l=(n+4)>>2;
  s=MMmalloc(m,l+1,TYPEBUF); if (s==NIL) return MERRMEM;
  m->tape[s+SizeHeader]=n;
  cr=(char*)&m->tape[s+SizeHeader+1];

  n=0;
  p=m->top[m->pp]>>1;
  while(p!=NIL)
  {
    q=m->tape[p+SizeHeader+OFFLVAL]>>1;
    if (q!=NIL)
    {
      nq=m->tape[q+SizeHeader];
      cq=(char*)&m->tape[q+SizeHeader+1];
      //$BLG - v5.11: Modif
      //memcpy((void*)(cr+n),(void*)cq,nq);
      BLG_memcpy8((void *)(cr+n), (void *)cq, nq);
      n+=nq;
    }
    p=m->tape[p+SizeHeader+OFFLNEXT]>>1;
  }
  cr[n]=0;
  m->top[m->pp]=s+s+1;
  return 0;
}


static int MBsizeword(int *deb)
{
  int i,l,k,n;
  char *p;

  l=*deb;
  p=(char*)&deb[1];
  n=0;
  for(i=0;i<l;i++)
  {
    k=p[i]&255;
    if ((k=='\\')||(k==' ')||(k==10)||(k==0)) n+=2;
    else if ((k<32)||(k>=128)) n+=4;
    else n++;
  }
  return n;
}


//$BLG - v5.3.01: Add
int MBlgetinfo(mmachine m)
{
  int l, n, s;
  int lst, plst, str, pstr, pline, pword, stop;
  char *c;

  str = m->top[m->pp++];
  lst = m->top[m->pp];
  if ((lst == NIL) || (str == NIL)) 
  {
    m->top[m->pp] = NIL;
    return MERROK;
  }	  
  
  pstr = str>>1;
  plst = lst>>1;
  n = 0;
  stop = 0;
  
  while ((plst != NIL) && (!stop))
  {
  	pline = m->tape[plst+SizeHeader+OFFLVAL]>>1;
  	if (pline != NIL)
  	{
  		pword = m->tape[pline+SizeHeader+OFFLVAL]>>1;
  		if (!strcmp((char *)&m->tape[pstr+SizeHeader+1], (char *)&m->tape[pword+SizeHeader+1]))
  		{
  			MMechostr(0, "lgetinfo %s - ", &m->tape[pword+SizeHeader+1]);
  			pline = m->tape[pline+SizeHeader+OFFLNEXT]>>1;
  			//pword = m->tape[pline+SizeHeader+OFFLVAL]>>1;
  			//MMechostr(0, "%s\n", &m->tape[pword+SizeHeader+1]);
  			stop = 1;
  		}
  	}
  	plst = m->tape[plst+SizeHeader+OFFLNEXT]>>1;
  }
  
  if ((!stop) || (pline == NIL))
  {
    m->top[m->pp] = NIL;
    return 0;
  }

	pword = m->tape[pline+SizeHeader+OFFLVAL]>>1;
  MMechostr(0, "%s\n", &m->tape[pword+SizeHeader+1]);

  n = m->tape[pword+SizeHeader];
  l = (n + 4)>>2;
  s = MMmalloc(m, l+1, TYPEBUF); 
  if (s == NIL) 
  	return MERRMEM;
  
  m->tape[s+SizeHeader] = n;
  
  BLG_memcpy8((void *)&m->tape[s+SizeHeader+1], (void *)&m->tape[pword+SizeHeader+1], n);
  //m->tape[s+SizeHeader+1+n] = 0;
  c = (char *)&m->tape[s+SizeHeader+1];
  c[n] = 0;

  m->top[m->pp] = s+s+1;


  MMechostr(0, "n: %d\n", n);


  //m->top[m->pp] = pword<<1;		//In first version, this line was used. However, it could bring to stack corruption if a GC occured after call. This is however the way hd() is working ! Possible problem here ???
  return 0; 
}


//$BLG - v5.3.01: Add
int MBlgetinfoi(mmachine m)
{
  int l, n, s;
  int lst, plst, str, pstr, pline, pword, stop;
  char *c;

MMechostr(0, "lgetinfoi\n");

  str = m->top[m->pp++];
  lst = m->top[m->pp];
  if ((lst == NIL) || (str == NIL)) 
  {
    m->top[m->pp] = NIL;
    return MERROK;
  }	  
  
  pstr = str>>1;
  plst = lst>>1;
  n = 0;
  stop = 0;
  
  while ((plst != NIL) && (!stop))
  {
  	pline = m->tape[plst+SizeHeader+OFFLVAL]>>1;
  	if (pline != NIL)
  	{
  		pword = m->tape[pline+SizeHeader+OFFLVAL]>>1;
  		if (!strcasecmp((char *)&m->tape[pstr+SizeHeader+1], (char *)&m->tape[pword+SizeHeader+1]))
  		{
  			pline = m->tape[pline+SizeHeader+OFFLNEXT]>>1;
  			//pword = m->tape[pline+SizeHeader+OFFLVAL]>>1;
  			//MMechostr(0, "%s\n", &m->tape[pword+SizeHeader+1]);
  			stop = 1;
  		}
  	}
  	plst = m->tape[plst+SizeHeader+OFFLNEXT]>>1;
  }
  
  if ((!stop) || (pline == NIL))
  {
    m->top[m->pp] = NIL;
    return 0;
  }

	pword = m->tape[pline+SizeHeader+OFFLVAL]>>1;

  n = m->tape[pword+SizeHeader];
  l = (n + 4)>>2;
  s = MMmalloc(m, l+1, TYPEBUF); 
  if (s == NIL) 
  	return MERRMEM;
  
  m->tape[s+SizeHeader] = n;
  
  BLG_memcpy8((void *)&m->tape[s+SizeHeader+1], (void *)&m->tape[pword+SizeHeader+1], n);
  //m->tape[s+SizeHeader+1+n] = 0;
  c = (char *)&m->tape[s+SizeHeader+1];
  c[n] = 0;
  
  m->top[m->pp] = s+s+1;


	//m->top[m->pp] = pword<<1;		//In first version, this line was used. However, it could bring to stack corruption if a GC occured after call. This is however the way hd() is working ! Possible problem here ???
  return 0; 
}


//$BLG - v5.3.01: Add
int MBlgetinfos(mmachine m)
{
  int n, i, k;
  int lst, plst, str, pstr, pline, pword, stop;

MMechostr(0, "lgetinfos in\n");

  str = m->top[m->pp++];
  lst = m->top[m->pp];
  if ((lst == NIL) || (str == NIL)) 
  {
    MMechostr(0, "lgetinfos nil\n");
    m->top[m->pp] = NIL;
    return MERROK;
  }	  
  
  pstr = str>>1;
  plst = lst>>1;
  n = 0;
  stop = 0;
  MMechostr(0, "m->pp: %d\n", m->pp);
MMechostr(0, "lgetinfos search %s\n", (char *)&m->tape[pstr+SizeHeader+1]);  
  while ((plst != NIL) && (!stop))
  {
  	pline = m->tape[plst+SizeHeader+OFFLVAL]>>1;
  	if (pline != NIL)
  	{
  		pword = m->tape[pline+SizeHeader+OFFLVAL]>>1;
  		if (!strcmp((char *)&m->tape[pstr+SizeHeader+1], (char *)&m->tape[pword+SizeHeader+1]))
  		{
  			pline = m->tape[pline+SizeHeader+OFFLNEXT]>>1;
  				//pword = m->tape[pline+SizeHeader+OFFLVAL]>>1;
  				//MMechostr(0, "> %d %s\n", pline, &m->tape[pword+SizeHeader+1]);
  			stop = 1;
  		}
  	}
  	plst = m->tape[plst+SizeHeader+OFFLNEXT]>>1;
  }
MMechostr(0, "lgetinfos searched\n");  
  if ((!stop) || (pline == NIL))
  {
    MMechostr(0, "lgetinfos nil\n");
    m->top[m->pp] = NIL;
    return 0;
  }
MMechostr(0, "lgetinfos not nil\n");

	while (pline != NIL)
	{
		n++;
		pword = m->tape[pline+SizeHeader+OFFLVAL]>>1;
MMechostr(0, "> %d %s\n", pline, &m->tape[pword+SizeHeader+1]);
		if (MMpush(m, pword<<1))
			return MERRMEM;
		
		pline = m->tape[pline+SizeHeader+OFFLNEXT]>>1;
	}
	
	if (MMpush(m, NIL))
		return MERRMEM;
	
MMechostr(0, "lgetinfos pushed\n");	
	for(i = 0; i < n; i++)
	{
		if (MMpush(m, 2<<1)) 
			return MERRMEM;
		
		if (k = MBdeftab(m)) 
			return k;
	}
MMechostr(0, "lgetinfos deftab\n");
	MMset(m, 1, MMget(m, 0));
	MMpull(m);
MMechostr(0, "m->pp: %d\n", m->pp);
MMechostr(0, "lgetinfos out\n");


	//m->top[m->pp] = pline<<1;
  return 0; 
}


//$BLG - v5.3.01: Add
//$BB rewrite
//$BB very dangerous still assign bad ptr after a GC
//$BB crash sample ^^
/*
var l1 = "1"::"2"::"3"::"4"::"5"::nil;;
var l2 = "6"::"7"::"8"::"9"::"10\n"::nil;;

fun main()=	
  _showconsole;
  _fooS "\n";
  let 10 -> iter in
  let 0 -> i in
  while i < iter do
  {
    set l2 = lcat l1 l2;
    set l1 = lcat l1 l2;
  
    _fooS strcatn lcat l1 l2;
    set i = i + 1;
  };
  _fooS strcatn lcat l1 l2;
	0;;
*/
int MBlcat(mmachine m)
{
  int k, l1, l2, i, lsize;
  lsize = 0;
  
  l2=MMpull(m);
  l1=MMpull(m);

  while((l1 != NIL) || (l2 != NIL))
  {
    if (l1 != NIL)
    {
      MMpush(m, MMfetch(m, l1>>1, OFFLVAL));
      l1 = MMfetch(m, l1>>1, OFFLNEXT);
    }
    else
    {
      MMpush(m, MMfetch(m, l2>>1, OFFLVAL));
      l2 = MMfetch(m, l2>>1, OFFLNEXT);
    }
    lsize++;
  }

	if(MMpush(m, NIL)) 
    return MERRMEM;

	for(i=0;i<lsize;i++)
	{
		if(MMpush(m,2*2)) 
      return MERRMEM;
		if(k=MBdeftab(m))
      return k;
	}

  return 0;
}


int NMBsizetext(char *c,int l)
{
	int i,n;

	n=l;
	for(i=0;i<l;i++)
	{
		if (((*c)=='\\')||((*c)=='"')||((*c)==10)||((*c)==0)) n++;
		c++;
	}
	return n;
}


char bufcom[MAXCOM+16];

static int MBcom2(mmachine m)
{
  char *buf;
  int a,i,j,k,l,c,n,x,s;
  char *p,*q;
  bool tooBig = false; // set to true if buffer overflows

//MMechostr(0, "> MBcom2\n");

  buf = bufcom;
  i = m->top[m->pp]>>1;
  j = m->top[m->pp+1]>>1;
  if ((i == NIL) || (j == NIL))
  {
    m->pp++;
    m->top[m->pp] = NIL;
    return 0;
  }

  p = (char*)&m->tape[i+SizeHeader/*+1*/];
//MMechostr(0, "1: %s\n", p);
  k = 2;
  while(((*p) != 32) && (*p)) buf[k++] = *(p++);
  n = 0;

//MMechostr(0, "2: %s\n", p);
  
  while(*p)
  {
    x = m->tape[j+SizeHeader+n]>>1;
    p++; /*espace*/
    if (m->tape[j+SizeHeader+n] == NIL)
    {
//MMechostr(0, "3: NIL\n");
      sprintf(&buf[k], " NIL");
      k += 4;
  		if (k >= MAXCOM) 
  		{
//MMechostr(0, "3: tooBig\n");        
        tooBig = true;
	    	goto exit;
	  	}
    }
    else if ((*p) == 'I')
    {
//MMechostr(0, "3: I\n");
      sprintf(&buf[k], " %x", x);
      k += strlen(&buf[k]);
		  if (k >= MAXCOM) 
		  {
		    tooBig = true;
		    goto exit;
		  }
    }
    else if ((*p) == 'S')
    {
//MMechostr(0, "3: S\n");
      l = m->tape[x+SizeHeader];
      q = (char*)&m->tape[x+SizeHeader+1];
//MMechostr(0, "   %d\n", l);
      buf[k++] = ' ';
      buf[k++] = '\"';
//MMechostr(0, "   %d %d %d %d\n", MAXCOM, k, k+2*l, k+NMBsizetext(q,l));
		  if (((k+2*l) >= MAXCOM) && (k+NMBsizetext(q,l) >= MAXCOM)) 
		  {
//MMechostr(0, "3: tooBig\n", l);
		    tooBig = true;
		    goto exit;
		  }
      for(a = 0; a < l; a++)
      {
        c =* (q++);
        if ((c == '\\') || (c == '\"')) 
        	buf[k++] = '\\';
			  else if (c == 10)
			  {
				  buf[k++] = '\\';
				  c = 'n';
			  }
        else if (c == 0)
        {
/*
          buf[k++]='\\';
          c='0';
          if (((*q)>='0')&&((*q)<='9'))
          {
            buf[k++]=c;
            buf[k++]=c;
          }
*/
          buf[k++] = '\\';
          c = 'z';
    		}
        buf[k++] = c;
      }
      buf[k++] = '\"';
    }
    else
    {
//MMechostr(0, "3: MERRTYP\n");
		  m->err = MERRTYP;
		  return MERRTYP;
    }
    p++;
    n++;
  }
  
  buf[k++] = 0;
  if (k >= MAXCOM) 
    tooBig = true;

exit:
//MMechostr(0, "MBcom2 - exit %d\n", (int)tooBig);
  if (tooBig)
    k = 2;    // truncate to 0

  buf[0] = (k-2)&255;
  buf[1] = ((k-2)>>8)&255;
  l = (k+3)>>2;
  
  s = MMmalloc(m, l, TYPEBUF); 
  if (s == NIL) return MERRMEM;
  
  p = (char*)&m->tape[s+SizeHeader];
  //$BLG - v5.11: Modif
  //memcpy((void*)p,(void*)buf,k);
//MMechostr(0, "MBcom2 - BLG_memcpy8\n");
  BLG_memcpy8((void *)p, (void *)buf, k);

  m->pp++;
  m->top[m->pp] = s+s+1;

//MMechostr(0, "< MBcom2\n");

  return 0;
}


int MBcom(mmachine m)
{
  int pp, k;

	//$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-50>MAXSOCKS-50) return -1; /*FLIC*/
	
	//MMechostr(0, "> MBcom - New Comm\n");
  pp = m->pp;
  if (k = MBcom2(m))
  {
		m->pp = pp + 1;
		MMset(m,0,NIL);
  }
  //MMechostr(0, "< MBcom\n");
  return k;
}


static int MBcomv2(mmachine m)
{
  char *buf;
  int a,i,j,k,l,c,n,x,s;
  char *p,*q;
  bool tooBig = false; // set to true if buffer overflows

  buf=bufcom;
  i=m->top[m->pp]>>1;
  j=m->top[m->pp+1]>>1;
  s=m->top[m->pp+2]>>1;
  if ((i==NIL)||(j==NIL)||(s==NIL))
  {
    m->pp+=2;
    m->top[m->pp]=NIL;
    return 0;
  }
  p=(char*)&m->tape[i+SizeHeader/*+1*/];
  q=(char*)&m->tape[s+SizeHeader+1];
  k=0;
  k=strlen(q)+2;
  if (k>=MAXCOM) 
  {
    tooBig = true;
		goto exit;
  }
  strcpy(&buf[2],q);
  n=0;
  while(*p)
  {
    x=m->tape[j+SizeHeader+n]>>1;
    p++; /*espace*/
    if (m->tape[j+SizeHeader+n]==NIL)
    {
      sprintf(&buf[k]," NIL");
      k+=4;
		  if (k>=MAXCOM) 
		  {
		    tooBig = true;
		    goto exit;
		  }
    }
    else if ((*p)=='I')
    {
      sprintf(&buf[k]," %x",x);
      k+=strlen(&buf[k]);
		  if (k>=MAXCOM) 
		  {
		    tooBig = true;
		    goto exit;
		  }
    }
    else if ((*p)=='S')
    {
      l=m->tape[x+SizeHeader];
      q=(char*)&m->tape[x+SizeHeader+1];
      buf[k++]=' ';
      buf[k++]='\"';
		  if (((k+2*l)>=MAXCOM)&&(k+NMBsizetext(q,l)>=MAXCOM))
		  {
		    tooBig = true;
				goto exit;
		  }
      for(a=0;a<l;a++)
      {
        c=*(q++);
        if ((c=='\\')||(c=='\"')) 
        	buf[k++]='\\';
			  else if (c==10)
			  {
				  buf[k++]='\\';
				  c='n';
			  }
        else if (c==0)
        {
/*
          buf[k++]='\\';
          c='0';
          if (((*q)>='0')&&((*q)<='9'))
          {
            buf[k++]=c;
            buf[k++]=c;
          }
*/
          buf[k++]='\\';
          c='z';
				}
        buf[k++]=c;
      }
      buf[k++]='\"';
    }
    else
    {
		  m->err=MERRTYP;
		  return MERRTYP;
    }
    p++;
    n++;
  }
  buf[k++]=0;
  if (k>=MAXCOM) 
    tooBig = true;
exit:
  if (tooBig)
    k = 2; // truncate to 0

  buf[0]=(k-2)&255;
  buf[1]=((k-2)>>8)&255;
  l=(k+3)>>2;
  s=MMmalloc(m,l,TYPEBUF); if (s==NIL) return MERRMEM;
  p=(char*)&m->tape[s+SizeHeader];
  //$BLG - v5.11: Modif
  //memcpy((void*)p,(void*)buf,k);
  BLG_memcpy8((void *)p, (void *)buf, k);

  m->pp+=2;
  m->top[m->pp]=s+s+1;
  return 0;
}

int MBcomv(mmachine m)
{
  int pp,k;

  pp=m->pp;
  if (k=MBcomv2(m))
  {
		m->pp=pp+2;
		MMset(m,0,NIL);
  }
  return k;
}


int isCommTooBig(mmachine m)
//$ FA(16/05/2002): Returns 1 if communication message overflowed; 0 otherwise
{
  if (MMget(m, 0) == NIL) 
  {
    MMset(m, 0, NIL);
    return 0;
  }
  const char* p = (const char*)&m->tape[(MMget(m, 0)>>1)+SizeHeader];
  MMset(m, 0, (p[0] == 0 && p[1] == 0) ? 2 : 0);
  return 0;
}


static int MBctoa(mmachine m)
{
  int i,s;
  char *p;
  
  i=m->top[m->pp];
  if (i==NIL) return 0;
  i>>=1;
  s=MMmalloc(m,2,TYPEBUF); if (s==NIL) return MERRMEM;
  m->tape[s+SizeHeader]=1;
  p=(char*)&m->tape[s+SizeHeader+1];
  p[0]=i;
  p[1]=0;
  m->top[m->pp]=s+s+1;
  return 0;
}


static int MBmkscript(mmachine m)
{
  char *cp,*cr;
  int l,sl,s,p;

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

  p=m->top[m->pp];
  if (p==NIL) return 0;
//MMechostr(0,"MBmkscript stp 1\n");

  cr=(char*)&m->tape[(p>>1)+SizeHeader];
  l=(cr[0]&255)+((cr[1]&255)<<8);

  sl=(l+4)>>2;
  s=MMmalloc(m,sl+1,TYPEBUF); if (s==NIL) return MERRMEM;
//MMechostr(0,"MBmkscript stp 2\n");

  m->tape[s+SizeHeader]=l;
  cr=(char*)&m->tape[s+SizeHeader+1];

  p=m->top[m->pp];
  cp=(char*)&m->tape[(p>>1)+SizeHeader]; cp+=2;

  //$BLG - v5.11: Modif
  //memcpy((void*)cr,(void*)cp,l-1);
//MMechostr(0,"MBmkscript stp 3 %d\n", l);
  BLG_memcpy8((void *)cr, (void *)cp, l-1);
//MMechostr(0,"MBmkscript stp 4\n");
	//$BLG - v5.22: Modif
	//There is at least one possibility for "script" size to be equal to 0.
	//This is the case when a too big message is sent through a defcom.
	//When this happens, the cr[l-1]=10 corrupts the size of the data to send
	//(0xA000000) and triggers a crash in MBcom2()/NMBsizetext() by accessing
	//protected memory.
  //cr[l-1]=10;
  //cr[l]=0;
  if (l != 0)
  	cr[l-1]=10;
  cr[l]=0;

  m->top[m->pp]=s+s+1;

//MMechostr(0,"<MBmkscript\n");  
  return 0;
}


static int MBstrlowercase(mmachine m)
{
  int scolString = MMget(m, 0);
  if (scolString==NIL)
	return 0;
  
  if (int k=MBstrdup(m))
    return k;
  
  int l=MMsizestr(m, scolString>>1);
  char* p=MMstartstr(m, scolString>>1);

  BLG_lowercase(p, l);
  return 0;
}


static int MBstruppercase(mmachine m)
{
  int scolString = MMget(m, 0);
  if (scolString==NIL)
    return 0;

  if (int k=MBstrdup(m))
    return k;
  
  int l=MMsizestr(m, scolString>>1);
  char* p=MMstartstr(m, scolString>>1);

  BLG_uppercase(p, l);
  return 0;
}


static int MBstrcmpi(mmachine m)
{
  int p,q;
  char *cp,*cq;

  q=MMpull(m);
  p=MMget(m, 0);
  if ((p==NIL) || (q==NIL))
  {
    if ((p==NIL) && (q==NIL))
      MMset(m, 0, ITOM(0));
    else if (p!=NIL)
      MMset(m, 0, ITOM(1));
    else
      MMset(m, 0, ITOM(-1));
    return 0;
  }
  cp=MMstartstr(m, MTOP(p));
  cq=MMstartstr(m, MTOP(q));
//$ FA(02/07/2001): Replace old stricmp() by strcasecmp()
  MMset(m, 0, ITOM(strcasecmp(cp,cq)));
  return 0;
}

//
// List management and miscellaneous
//
static int MBstrextr2(mmachine m)
{
  int p,l,s,b,k,deb,i,j,ls,n,nc,mots;
  char *cp,*cr;

  b=m->pp;
  p=m->top[b]>>1;
  if (p==NIL) return 0;
  l=m->tape[p+SizeHeader];

  i=n=mots=0;
  while(i<l)
  {
    p=m->top[b]>>1;
    cp=(char*)&m->tape[p+SizeHeader+1];
    while((i<l)&&((cp[i]==32)||(cp[i]==10)||(cp[i]==13)))
    {
      if (cp[i]==10)
      {
        if (MMpush(m,NIL)) return MERRMEM;
        for(j=0;j<mots;j++)
        {
          if (MMpush(m,2*2)) return MERRMEM;
          if (k=MBdeftab(m)) return k;
        }
        mots=0;
        n++;
			  p=m->top[b]>>1;
			  cp=(char*)&m->tape[p+SizeHeader+1];			  
		  }
      i++;
    }
    deb=i;
    nc=0;
    while((i<l)&&(cp[i]!=32)&&(cp[i]!=10)&&(cp[i]!=13))
    {
      if (cp[i]=='\\')
      {
        i++;
        if (i>=l) 
        	nc++;
			  else
			  {
          if (cp[i]<32)
            while((i<l)&&((cp[i]<32))) i++;
          else
					{
            if ((cp[i]>='0')&&(cp[i]<='9'))
            {
              i++;
              if ((i<l)&&(cp[i]>='0')&&(cp[i]<='9'))
              {
                i++;
                if ((i<l)&&(cp[i]>='0')&&(cp[i]<='9'))
                {
                  i++;
                }
              }
            }
            else i++;
            nc++;
          }
		  	}
      }
      else
      {
        i++;
        nc++;
      }
    }

    if (nc)
    {
      ls=(nc+4)>>2;
      s=MMmalloc(m,ls+1,TYPEBUF); if (s==NIL) return MERRMEM;

      m->tape[s+SizeHeader]=nc;
      cr=(char*)&m->tape[s+SizeHeader+1];
      p=m->top[b]>>1;
      cp=(char*)&m->tape[p+SizeHeader+1];
      i=deb;
      
      while((i<l)&&(cp[i]!=32)&&(cp[i]!=10)&&(cp[i]!=13))
      {
        if (cp[i]=='\\')
        {
          i++;
          if (i>=l) 
          	*(cr++)=cp[i-1];
				  else
				  {
            if (cp[i]<32)
              while((i<l)&&((cp[i]<32))) i++;
            else
            {
              if ((cp[i]>='0')&&(cp[i]<='9'))
              {
                k=cp[i]-'0';
                i++;
                if ((cp[i]>='0')&&(cp[i]<='9'))
                {
                  k=k*10+cp[i]-'0';
                  i++;
                  if ((cp[i]>='0')&&(cp[i]<='9'))
                  {
                    k=k*10+cp[i]-'0';
                    i++;
                  }
                }
                *(cr++)=k;
              }
              else if (cp[i]=='n')
              {
                *(cr++)=10;
                i++;
              }
              else if (cp[i]=='z')
              {
                *(cr++)=0;
                i++;
              }
              else
              {
                *(cr++)=cp[i];
                i++;
              }
            }
  				}
        }
        else
        {
          *(cr++)=cp[i];
          i++;
        }
      }
      
      *cr=0;
      mots++;
      if (MMpush(m,s+s+1)) return MERRMEM;
    }
  }
  if (mots)
  {
    if (MMpush(m,NIL)) return MERRMEM;
    for(j=0;j<mots;j++)
    {
      if (MMpush(m,2*2)) return MERRMEM;
      if (k=MBdeftab(m)) return k;
    }
    n++;
  }
  if (MMpush(m,NIL)) return MERRMEM;
  for(i=0;i<n;i++)
  {
    if (MMpush(m,2*2)) return MERRMEM;
    if (k=MBdeftab(m)) return k;
  }
  m->top[b]=MMpull(m);
  return 0;
}

//$BLG - v5.11: Del
//cf note at beginning of file
//extern int maxsock; /*FLIC*/

static int MBstrextr(mmachine m)
{
  int pp;

	//$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*2>MAXSOCKS*2) return -1; /*FLIC*/

  pp=m->pp;
  if (MBstrextr2(m))
  {
    m->pp=pp;
    m->top[m->pp]=NIL;
  }
  return 0;
}


char *MBcopyword(char *cr,int *deb)
{
  int i,l,k;
  char *p;

  l=*deb;
  p=(char*)&deb[1];

  for(i=0;i<l;i++)
  {
    k=p[i]&255;
    if ((k=='\\')||(k==' '))
    {
      *(cr++)='\\';
      *(cr++)=k;
    }
    else if (k==10)
    {
      *(cr++)='\\';
      *(cr++)='n';
    }
    else if (k==0)
    {
      *(cr++)='\\';
      *(cr++)='z';
    }
    else if ((k<32)||(k>=128))
    {
      *(cr++)='\\';
      *(cr++)='0'+k/100;
      k=k%100;
      *(cr++)='0'+k/10;
      k=k%10;
      *(cr++)='0'+k;
    }
    else 
    	*(cr++)=p[i];
  }
  return cr;
}

static int MBstrbuild(mmachine m)
{
  int p,q,l,n,r,s,f;
  char *cr;

  n=0;
  p=m->top[m->pp]>>1;
  while(p!=NIL)
  {
    f=0;
    q=m->tape[p+SizeHeader+OFFLVAL]>>1;
    while(q!=NIL)
    {
      r=m->tape[q+SizeHeader+OFFLVAL]>>1;
      if (f) n++;
      if (r!=NIL) n+=MBsizeword((int*)&m->tape[r+SizeHeader]);
      f=1;
      q=m->tape[q+SizeHeader+OFFLNEXT]>>1;
    }
    n++;
    p=m->tape[p+SizeHeader+OFFLNEXT]>>1;
  }

  l=(n+4)>>2;
  s=MMmalloc(m,l+1,TYPEBUF); if (s==NIL) return MERRMEM;
  m->tape[s+SizeHeader]=n;
  cr=(char*)&m->tape[s+SizeHeader+1];

  p=m->top[m->pp]>>1;
  while(p!=NIL)
  {
    f=0;
    q=m->tape[p+SizeHeader+OFFLVAL]>>1;
    while(q!=NIL)
    {
      r=m->tape[q+SizeHeader+OFFLVAL]>>1;
      if (f) *(cr++)=' ';
      if (r!=NIL) cr=MBcopyword(cr,(int*)&m->tape[r+SizeHeader]);
      f=1;
      q=m->tape[q+SizeHeader+OFFLNEXT]>>1;
    }
    *(cr++)=10;
    p=m->tape[p+SizeHeader+OFFLNEXT]>>1;
  }
  *cr=0;
  m->top[m->pp]=s+s+1;
  return 0;
}

static int MBstrbuild2(mmachine m)
{
  int p,q,l,n,r,s,f;
  char *cr;

  n=0;
  p=m->top[m->pp]>>1;
  while(p!=NIL)
  {
    f=0;
    q=m->tape[p+SizeHeader+OFFLVAL]>>1;
    while(q!=NIL)
    {
      r=m->tape[q+SizeHeader+OFFLVAL]>>1;
      if (f) n++;
      if (r!=NIL) n+=MBsizeword((int*)&m->tape[r+SizeHeader]);
      f=1;
      q=m->tape[q+SizeHeader+OFFLNEXT]>>1;
    }
    n+=2;
    p=m->tape[p+SizeHeader+OFFLNEXT]>>1;
  }

  l=(n+4)>>2;
  s=MMmalloc(m,l+1,TYPEBUF); if (s==NIL) return MERRMEM;
  m->tape[s+SizeHeader]=n;
  cr=(char*)&m->tape[s+SizeHeader+1];

  p=m->top[m->pp]>>1;
  while(p!=NIL)
  {
    f=0;
    q=m->tape[p+SizeHeader+OFFLVAL]>>1;
    while(q!=NIL)
    {
      r=m->tape[q+SizeHeader+OFFLVAL]>>1;
      if (f) *(cr++)=' ';
      if (r!=NIL) cr=MBcopyword(cr,(int*)&m->tape[r+SizeHeader]);
      f=1;
      q=m->tape[q+SizeHeader+OFFLNEXT]>>1;
    }
    *(cr++)=13;
    *(cr++)=10;
    p=m->tape[p+SizeHeader+OFFLNEXT]>>1;
  }
  *cr=0;
  m->top[m->pp]=s+s+1;
  return 0;
}

static int MBlineextr(mmachine m)
{
  int p,l,s,b,k,deb,i,ls,n,nc,flag;
  char *cp,*cr;

  b=m->pp;
  p=m->top[b]>>1;
  if (p==NIL) return 0;
  l=m->tape[p+SizeHeader];

  i=n=flag=0;
  while(i<l)
  {
    p=m->top[b]>>1;
    cp=(char*)&m->tape[p+SizeHeader+1];
    while((i<l)&&((cp[i]==10)||(cp[i]==13)))
	  {
		  if (cp[i]==10)
		  {
			  if (flag) flag=0;
			  else
			  {
				  if (MMpush(m,NIL)) return MERRMEM;
				  n++;
				  p=m->top[b]>>1;
				  cp=(char*)&m->tape[p+SizeHeader+1];
			  }
		  }
		  i++;
	  }

    deb=i;
    nc=0;
    while((i<l)&&(cp[i]!=10)&&(cp[i]!=13)) i++;
	  nc=i-deb;
    if (nc)
    {
      ls=(nc+4)>>2;
      s=MMmalloc(m,ls+1,TYPEBUF); if (s==NIL) return MERRMEM;

      m->tape[s+SizeHeader]=nc;
      cr=(char*)&m->tape[s+SizeHeader+1];
      p=m->top[b]>>1;
      cp=(char*)&m->tape[p+SizeHeader+1];
      i=deb;
      
      while(i<deb+nc) *(cr++)=cp[i++];
      *cr=0;
      if (MMpush(m,s+s+1)) return MERRMEM;
	  	n++;
	  	flag=1;
    }
  }

  if (MMpush(m,NIL)) return MERRMEM;
  for(i=0;i<n;i++)
  {
    if (MMpush(m,2*2)) return MERRMEM;
    if (k=MBdeftab(m)) return k;
  }
  m->top[b]=MMpull(m);
  return 0;
}


static int MBlinebuild(mmachine m)
{
  int q,l,n,r,s;
  char *cr;

  n=0;
  q=m->top[m->pp]>>1;
  while(q!=NIL)
  {
    r=m->tape[q+SizeHeader+OFFLVAL]>>1;
    if (r!=NIL) n+=MMsizestr(m,r);
   	n++;
    q=m->tape[q+SizeHeader+OFFLNEXT]>>1;
  }

  l=(n+4)>>2;
  s=MMmalloc(m,l+1,TYPEBUF); if (s==NIL) return MERRMEM;
  m->tape[s+SizeHeader]=n;
  cr=(char*)&m->tape[s+SizeHeader+1];

  q=m->top[m->pp]>>1;
  while(q!=NIL)
  {
    r=m->tape[q+SizeHeader+OFFLVAL]>>1;
    if (r!=NIL)
    {
      //$BLG - v5.11: Modif
      //memcpy(cr,MMstartstr(m,r),MMsizestr(m,r));
      BLG_memcpy8(cr, MMstartstr(m, r), MMsizestr(m, r));
  		cr+=MMsizestr(m,r);
    }
    *(cr++)=10;
    q=m->tape[q+SizeHeader+OFFLNEXT]>>1;
  }
  *cr=0;
  m->top[m->pp]=s+s+1;
  return 0;
}

static int MBlinebuild2(mmachine m)
{
  int q,l,n,r,s;
  char *cr;

  n=0;
  q=m->top[m->pp]>>1;
  while(q!=NIL)
  {
    r=m->tape[q+SizeHeader+OFFLVAL]>>1;
    if (r!=NIL) n+=MMsizestr(m,r);
   	n+=2;
    q=m->tape[q+SizeHeader+OFFLNEXT]>>1;
  }

  l=(n+4)>>2;
  s=MMmalloc(m,l+1,TYPEBUF); if (s==NIL) return MERRMEM;
  m->tape[s+SizeHeader]=n;
  cr=(char*)&m->tape[s+SizeHeader+1];

  q=m->top[m->pp]>>1;
  while(q!=NIL)
  {
    r=m->tape[q+SizeHeader+OFFLVAL]>>1;
    if (r!=NIL)
    {
      //$BLG - v5.11: Modif
      //memcpy(cr,MMstartstr(m,r),MMsizestr(m,r));
      BLG_memcpy8(cr, MMstartstr(m, r), MMsizestr(m, r));
  		cr+=MMsizestr(m,r);
    }
    *(cr++)=13;
    *(cr++)=10;
    q=m->tape[q+SizeHeader+OFFLNEXT]>>1;
  }
  *cr=0;
  m->top[m->pp]=s+s+1;
  return 0;
}


//$BLG - v5.11: Add
//MBstrcatinit - fun [I] S 
//Initializes an empty string of given length
//Base code from MBstrcat
int MBstrcatinit(mmachine m)
{
  int psize, size, len, str;
  
  //MMget(0)>>1 & checks
  psize = m->top[m->pp];
  if (psize == NIL)		{ return -1; }
  size = psize>>1;
  if (size < 0)			{ m->top[m->pp] = NIL; return -1; }
  
  //MMmalloc():
  len = (size +4)>>2;
  str = MMmallocCLR(m, len +1 +1, TYPEBUF);
  if (str == MERRMEM) 	{ return str; }					// Note: MERRMEM and NIL  have the same value (-1)
  m->tape[str+SizeHeader] = size;
  //m->tape[str + SizeHeader + 1 + len] = 0;
  
  //MMset(0)<<1
  m->top[m->pp] = (str<<1)+1;
  
  return 0;
}



//$BLG - v5.11: Add
//MBstrcatblit - fun [S S] S
//Copies a standard string at the end of an initialized one
//Base code from MBstrcat
int MBstrcatblit(mmachine m)
{
  int psrc, src, lsrc, pdst, dst, ldst, pos, len;
  char *csrc, *cdst;

  //Destination (Initialized S)
  pdst = MMpull(m);
  if (pdst == NIL)		{ MMset(m, 0, NIL); return -1; }
  dst = pdst>>1;
  ldst = m->tape[dst + SizeHeader];
  pos = m->tape[dst + SizeHeader + 1 + ((ldst+4)>>2)];
  cdst = (char *)&m->tape[dst + SizeHeader + 1];
  cdst += pos;
  
  //Source (Standard S)
  psrc = MMget(m, 0);
  if (psrc == NIL)		{ return -1; }
  src = psrc>>1;
  lsrc = m->tape[src + SizeHeader];
  csrc = (char *)&m->tape[src + SizeHeader + 1];  
  
  //Real length to copy
  if ((pos + lsrc) > ldst)		{len = ldst - pos; } else { len = lsrc; }
  
  //Copy
  //memcpy((void *)cdst, (void *)csrc, len);
  BLG_memcpy8((void *)cdst, (void *)csrc, len);
  m->tape[dst + SizeHeader + 1 + ((ldst+4)>>2)] += len; 
  //Output
  MMset(m, 0, pdst);
  
  return 0;
}


//$BLG - v5.11: Add
//MBstrcatlen - fun [S] I
//Finds the current length of an initialized string
//Base code from MBstrcat
int MBstrcatlen(mmachine m)
{
  int psrc, src, lsrc, len;
  
  //Source
  psrc = MMget(m, 0);
  if (psrc == NIL)		{ return -1; }
  src = psrc>>1;
  lsrc = m->tape[src + SizeHeader];
  len = m->tape[src + SizeHeader + 1 + ((lsrc+4)>>2)];
	//Output
	MMset(m, 0, len<<1);
	  
	return 0;
}


/*
static int MBset_nth_char(mmachine m)
{
  int p,l,a,c;
  char *cp;

  c=MMpull(m)>>1;
  a=MMpull(m)>>1;
  p=m->top[m->pp];
  if ((p==NIL)||(a==NIL)||(c==NIL))
    {
      m->top[m->pp]=NIL;
      return 0;
    }
  p>>=1;
  l=m->tape[p+SizeHeader];
  cp=(char*)&m->tape[p+SizeHeader+1];
  if ((a>=0)&&(a<l)) cp[a]=c;
  return 0;
}
*/

//$BLG - v5.24: Add
//MBstrmd5 - fun [S] S
//Basecode from MBstrdup
int MBstrmd5(mmachine m)
{
  int p, l, s, sl;
  //char *cp, *cr;
  char *cp;
  
  MD5_CTX context;
	unsigned char digest[16];
	//unsigned int len = strlen (string);
	int i;
	unsigned char c, c1, c2;

  p = MMget(m, 0);
  if (p == NIL) 
  	return 0;
  
  //l = 16;
  l = 32;
  sl = (l+4)>>2;
  s = MMmalloc(m, sl+1, TYPEBUF); 
  if (s == NIL) 
  	return MERRMEM;

  m->tape[s+SizeHeader] = l;
  cp = (char*) &m->tape[s+SizeHeader+1];
	cp[l] = 0;
	
  p = MMget(m, 0);
  p >>= 1;
	MD5Init(&context);
	MD5Update(&context, (unsigned char *)&m->tape[p+SizeHeader+1], m->tape[p+SizeHeader]);
	//MD5Final((unsigned char *)&m->tape[s+SizeHeader+1], &context);
	MD5Final(digest, &context);
	
	for (i = 0; i < 16; i++)
	{
		c = digest[i];
		c1 = c>>4;
		if (c1 <= 9)
			cp[i*2] = (unsigned char)(c1 + 48);
		else
			cp[i*2] = (unsigned char)(c1 + 97 - 10);
		c2 = c&15;
		if (c2 <= 9)
			cp[(i*2)+1] = (unsigned char)(c2 + 48);
		else
			cp[(i*2)+1] = (unsigned char)(c2 + 97 - 10);
		//MMechostr(0, "%1x%1x %d-%d ", c1, c2, c1, c2);
	}
	//MMechostr(0,"\n");
	
	/*
	printf("> (\"%s\") = ", string);
	MDPrint(digest);
	printf("\n");  
	*/
  
  /*
  cr=(char*)&m->tape[s+SizeHeader+1];
  p=m->top[m->pp];
  cp=(char*)&m->tape[(p>>1)+SizeHeader+1];
  //$BLG - v5.11: Modif
  //memcpy((void*)cr,(void*)cp,l);
  BLG_memcpy8((void *)cr, (void *)cp, l);
  cr[l]=0;
  */

  MMset(m, 0, s+s+1);
  return 0;
}


//$BLG - v5.2.06: Add
//MBstrtrim - fun [S] S
//Basecode from MBstrdup
int MBstrtrim(mmachine m)
{
  int p, l;
  char *cp;
  int dstlen, dststa, i;

  p = MMpull(m);
  if (p == NIL)
  {
  	MMpush(m, NIL);
    return 0;
  }

  l = MMsizestr(m, MTOP(p));
  cp = MMstartstr(m, MTOP(p));

  dstlen = l;
  dststa = 0;
  i = 0;

  //Finding 1st non SPACE and /t char in source
  while (((cp[i] == ' ') || (cp[i] == '\t') || (cp[i] == '\n')) && (i < l))
  {
  	dstlen--;
  	dststa++;
  	i++;
  }

  //Finding last non SPACE char in source
  if (i != l)
  {
	  i = l - 1;
	  while (((cp[i] == ' ') || (cp[i] == '\t') || (cp[i] == '\n')) && (i >= 0))
	  {
	  	dstlen--;
	  	i--;
	  }
	}

  //no change
  if (dstlen == l)
  {
    MMpush(m, p);
    return 0;
  }

  cp += dststa;  
  Mpushstrblocn(m, cp, dstlen);
  return 0;
}


//
// Time functions **************************************************************
//


static int MBtime(mmachine m)
{
  time_t timep;
  
  time(&timep);
  return MMpush(m,timep*2);
}


static int MBctime(mmachine m)
{
  time_t timep;
  char buf[256];

  timep=(MMpull(m)>>1)&0x7fffffff;
  strcpy(buf,ctime(&timep));
  return Mpushstrbloc(m,buf);
}


static int MBgmtime(mmachine m)
{
  time_t timep;
  struct tm *res;
  int k;

  timep=(MMpull(m)>>1)&0x7fffffff;
  res=gmtime(&timep);
  if ((k=MMpush(m,res->tm_sec<<1))) return k;
  if ((k=MMpush(m,res->tm_min<<1))) return k;
  if ((k=MMpush(m,res->tm_hour<<1))) return k;
  if ((k=MMpush(m,res->tm_mday<<1))) return k;
  if ((k=MMpush(m,(res->tm_mon+1)<<1))) return k;
  if ((k=MMpush(m,(res->tm_year+1900)<<1))) return k;
  if ((k=MMpush(m,res->tm_wday<<1))) return k;
  if ((k=MMpush(m,res->tm_yday<<1))) return k;
  if ((k=MMpush(m,8<<1))) return k;
  return MBdeftab(m);
}


static int MBlocaltime(mmachine m)
{
  time_t timep;
  struct tm *res;
  int k;

  timep=(MMpull(m)>>1)&0x7fffffff;
  res=localtime(&timep);
  if (res==NULL) return MMpush(m,NIL);
  if ((k=MMpush(m,res->tm_sec<<1))) return k;
  if ((k=MMpush(m,res->tm_min<<1))) return k;
  if ((k=MMpush(m,res->tm_hour<<1))) return k;
  if ((k=MMpush(m,res->tm_mday<<1))) return k;
  if ((k=MMpush(m,(res->tm_mon+1)<<1))) return k;
  if ((k=MMpush(m,(res->tm_year+1900)<<1))) return k;
  if ((k=MMpush(m,res->tm_wday<<1))) return k;
  if ((k=MMpush(m,res->tm_yday<<1))) return k;
  if ((k=MMpush(m,8<<1))) return k;
  return MBdeftab(m);
}


//
// Lists functions *************************************************************
//


static int MBhd(mmachine m)
{
  int p;
  
  p=m->top[m->pp];
  if (p==NIL) return 0;
  m->top[m->pp]=m->tape[(p>>1)+SizeHeader+OFFLVAL];
  return 0;
}


int MBtl(mmachine m)
{
  int p;
  
  p=m->top[m->pp];
  if (p==NIL) return 0;
  m->top[m->pp]=m->tape[(p>>1)+SizeHeader+OFFLNEXT];
  return 0;
}


static int MBsizelist(mmachine m)
{
  int i,p;
  
  p=m->top[m->pp];
  i=0;
  while(p!=NIL)
  {
    p=m->tape[(p>>1)+SizeHeader+OFFLNEXT];
    i++;
  }
  m->top[m->pp]=i*2;
  return 0;
}


static int MBnth_list(mmachine m)
{
  int i,p;
  
  i=MMpull(m);
  if ((i==NIL)||(i<0))
  {
    m->top[m->pp]=NIL;
    return 0;
  }
  i>>=1;

  p=m->top[m->pp];
  while((p!=NIL)&&(i))
  {
    p=m->tape[(p>>1)+SizeHeader+OFFLNEXT];
    i--;
  }
  if (p!=NIL)
    m->top[m->pp]=m->tape[(p>>1)+SizeHeader+OFFLVAL];
  else
    m->top[m->pp]=NIL;
  return 0;
}


static int MBendlist(mmachine m)
{
  int i,p;
  
  i=MMpull(m);
  if ((i==NIL)||(i<0))
  {
    m->top[m->pp]=NIL;
    return 0;
  }
  i>>=1;

  p=m->top[m->pp];
  while((p!=NIL)&&(i))
  {
    p=m->tape[(p>>1)+SizeHeader+OFFLNEXT];
    i--;
  }
  m->top[m->pp]=p;
  return 0;
}


static int hexcar(int i)
{
  if (i<10) return 48+i;
  return 87+i;
}

int MBstrtoweb(mmachine m)
{
  char *p,*q;
  int i,l,ls,n,c,s;
  
  i=MMget(m,0);
  if (i==NIL) return 0;
  l=MMsizestr(m,i>>1);
  p=MMstartstr(m,i>>1);
  n=0;
  for(i=0;i<l;i++)
  {
    c=(*(p++))&255;
    if ((c==32)||((c>='0')&&(c<='9'))||((c>='a')&&(c<='z'))||((c>='A')&&(c<='Z'))) n++;
    else n+=3;
  }

  ls=(n+4)>>2;
  s=MMmalloc(m,ls+1,TYPEBUF); if (s==NIL) return MERRMEM;

  p=MMstartstr(m,MMget(m,0)>>1);
  MMsetsizestr(m,s,n);
  q=MMstartstr(m,s);
  for(i=0;i<l;i++)
  {
    c=(*(p++))&255;
    if (c==32) *(q++)='+';
    else if (((c>='0')&&(c<='9'))||((c>='a')&&(c<='z'))||((c>='A')&&(c<='Z'))) *(q++)=c;
    else
    {
      *(q++)='%';
      *(q++)=hexcar(c>>4);
      *(q++)=hexcar(c&15);
    }
  }
  *(q++)=0;
  MMset(m,0,s+s+1);
  return 0;
}


static int carhex(int i)
{
  if ((i>='0')&&(i<='9')) return i-48;
  if ((i>='A')&&(i<='F')) return i-55;
  if ((i>='a')&&(i<='f')) return i-87;
  return 0;
}

int MBwebtostr(mmachine m)
{
  char *p,*q;
  int i,l,ls,n,c,s;
  
  i=MMget(m,0);
  if (i==NIL) return 0;
  l=MMsizestr(m,i>>1);
  p=MMstartstr(m,i>>1);
  n=0;
  i=0;
  while(i<l)
  {
    c=p[i++]&255;
    if (c=='%') i+=2;
    n++;
  }
  if (i!=l)
  {
    MMset(m,0,NIL);
    return 0;
  }
  
  ls=(n+4)>>2;
  s=MMmalloc(m,ls+1,TYPEBUF); if (s==NIL) return MERRMEM;

  p=MMstartstr(m,MMget(m,0)>>1);
  MMsetsizestr(m,s,n);
  q=MMstartstr(m,s);
  i=0;
  while(i<l)
  {
    c=p[i++]&255;
    if (c=='+') *(q++)=' ';
    else if (c!='%') *(q++)=c;
    else
    {
      c=carhex(p[i]&255)*16+carhex(p[i+1]&255);
      i+=2;
      *(q++)=c;
    }
  }
  *(q++)=0;
  MMset(m,0,s+s+1);
  return 0;
}


//$BB for UTF8 conversion
int MButf8tostr(mmachine m)
{
	#if SCOL_PLATFORM == SCOL_PLATFORM_WINDOWS
		int istr = MMpull(m);
		if(istr==NIL)
		{ 
			MMset(m,0,NIL);
			return 0;	
		}
		char* str = MMstartstr(m, istr>>1);

		//Convert UTF-8 to ANSI
		int length = MultiByteToWideChar(CP_UTF8, 0, str, -1, NULL, 0);
		wchar_t* wstr = new wchar_t[length];
		MultiByteToWideChar(CP_UTF8, 0, str, -1, wstr, length); 

		int wchar_count = WideCharToMultiByte(CP_ACP, 0, wstr, -1, NULL, 0, NULL, NULL);
		char* cstr = new char[wchar_count];
		WideCharToMultiByte(CP_ACP, 0, wstr, -1, cstr, wchar_count, NULL, NULL);
		delete[] wstr;

		// Scol str
		Mpushstrbloc(m, cstr);

		delete[] cstr;
	#else
		// TODO_LINUX
		MMset(m, 0, NIL);
	#endif
	return 0;
}


//$BB for UTF8 conversion
int MBstrtoutf8(mmachine m)
{
	#if SCOL_PLATFORM == SCOL_PLATFORM_WINDOWS
		int istr = MMpull(m);
		if(istr==NIL)
		{ 
			MMset(m,0,NIL);
			return 0;	
		}
		char* str = MMstartstr(m, istr>>1);

		//Convert ANSI to UTF8
		int length = MultiByteToWideChar(CP_ACP, 0, str, -1, NULL, 0);
		wchar_t* wstr = new wchar_t[length];
		MultiByteToWideChar(CP_ACP, 0, str, -1, wstr, length); 

		int wchar_count = WideCharToMultiByte(CP_UTF8, 0, wstr, -1, NULL, 0, NULL, NULL);
		char* cstr = new char [wchar_count];
		WideCharToMultiByte(CP_UTF8, 0, wstr, -1, cstr, wchar_count, NULL, NULL);
		delete[] wstr;

		// Scol str
		Mpushstrbloc(m, cstr);

		delete[] cstr;
	#else
		// TODO_LINUX
		MMset(m, 0, NIL);
	#endif
	return 0;
}



static int MBlistmap(mmachine m)
//$ FA(07/01/2001): The famous 'map' function!
// [1] function
// [0] list
{
  if (SEGETTOP(m, 1) == NIL) 
  {
    SEDROP(m, 1);
    SESETTOP(m, 0, NIL);
    return MERROK;
  }
  SECHECK(SEPUSH(m, NIL)); // last node
  SECHECK(SEPUSH(m, NIL)); // result list
  SEINT i = SEGETSP(m);
  while (SEGET(m, i+2) != NIL) 
  {
    SECHECK(SEPUSH(m, SEHEAD(m, SEW2P(SEGET(m, i+2))))); // push list head
    SECHECK(SEPUSH(m, SEGET(m, i+3)));                   // push function
    Interpreter interp(m);                               // apply function
    int res = interp.call();
    if (res != MERROK && res != MERREND)
      return res;
    SECHECK(SEPUSH(m, NIL));
    SECHECK(SEPUSH(m, SEI2W(2)));
    SECHECK(SENEWTUPLE(m));                              // create new node
    SEWORD node = SEPOP(m);
    if (SEGET(m, i) == NIL) 
    { 
      SESET(m, i, node);
      SESET(m, i+1, node);
    } else 
    {
      SESETTAIL(m, SEW2P(SEGET(m, i+1)), node);
      SESET(m, i+1, node);
    }
    SESET(m, i+2, SETAIL(m, SEW2P(SEGET(m, i+2))));      // iterate at tail
  } // while
  SEWORD val = SEGETTOP(m, 0);
  SEDROP(m, 3);
  SESETTOP(m, 0, val);
  return MERROK;
}


// Decoupage d'une chaine en mots (retourne le nombre de mots) format script  
int Mcutting(char *comm, char **argv)
{
  int i,j,argc,inword;
  
  i=j=argc=0;
  inword=0;
  
  while(comm[i])
  {
    if ((inword)&&(comm[i]=='\\'))
    {
      i+=2;
    }
    else
    {
      if (comm[i]=='"') inword=1-inword;
      else if ((comm[i]<=32)&&(inword==0)) comm[i]=0;
      if ((j==0)&&(comm[i])) argv[argc++]=&comm[i];
      j=comm[i++];
    }
  }
  return argc;
}


// Récupère la première ligne; retourne un pointeur vers la ligne suivante ou 
// NULL si terminé ou erreur
char *stdGetLine(char *src,char *buf,int n)
{
  int c,i;

  while((c=255&(*(src++)))<32) if (c==0) return NULL;
  i=0;
  buf[i++]=c;
  while(((c=255&(*(src++)))>=32)&&(c)&&(i<n)) buf[i++]=c;
  if (c==0) src--;
  if (i==n) return NULL;
  buf[i]=0;
  return src;
}


// Decoupage d'une chaine en mots (retourne le nombre de mots) format strbuild
int strCutting(char *comm, char **argv)
{
  int i,j,k,argc;
  
  i=0;
  j=-1;
  argc=0;

  while(comm[i])
  {
	  if (comm[i]==32)
	  {
		  if (j>=0) comm[j]=0;
		  j=-1;
		  i++;
	  }
	  else
	  {
		  if (j==-1)
		  {
			  j=i;
			  argv[argc++]=&comm[i];
		  }
		  if (comm[i]=='\\')
		  {
			  i++;
              if ((comm[i]>='0')&&(comm[i]<='9'))
			  {
				  k=comm[i]-'0';
				  i++;
				  if ((comm[i]>='0')&&(comm[i]<='9'))
				  {
					  k=k*10+comm[i]-'0';
					  i++;
					  if ((comm[i]>='0')&&(comm[i]<='9'))
					  {
						  k=k*10+comm[i]-'0';
						  i++;
					  }
				  }
				  comm[j++]=k;
			  }
			  else if (comm[i]=='n')
			  {
				  comm[j++]=10;
				  i++;
			  }
			  else if (comm[i]=='z')
			  {
				  comm[j++]=0;
				  i++;
			  }
			  else
			  {
				  comm[j++]=comm[i];
				  if (comm[i]) i++;
			  }
		  }
		  else comm[j++]=comm[i++];
	  }
  }
  if (j>=0) comm[j]=0;
  return argc;
}


#if !defined(SCOL_STRICT)
int FUNlist(mmachine m)
{
  int p;
  p=MMget(m,0);
  if (p==NIL) return 0;
  MMset(m,0,MMfetch(m,MMfetch(m,p>>1,OFFLVAL)>>1,OFFPKINTRN));
  return 0;
} 
 

int FUNctoscol(mmachine m)
{
  int p,q,l,ll;
  char *c,*d;
 
  p=MMget(m,0)>>1;
  if (p==NIL) return 0;
  c=(char*)MMstart(m,p);
  l=strlen(c);
  ll=(l+4)>>2;
 
  q=MMmalloc(m,ll+1,TYPEBUF); if (q==NIL) return MERRMEM;
  MMsetsizestr(m,q,l);
  d=(char*)MMstartstr(m,q);
  p=MMget(m,0)>>1;
  c=(char*)MMstart(m,p);
  strcpy(d,c);
  MMset(m,0,q+q+1);
  return 0;
}
#endif



NativeDefinition base[] = {
  { "rand",         0, "fun [] I",                     MBrand         },
  { "srand",        1, "fun [I] I",                    MBsrand        },
  { "max",          2, "fun [I I] I",                  MBmax          },
  { "min",          2, "fun [I I] I",                  MBmin          },
  { "abs",          1, "fun [I] I",                    MBabs          },
  { "itoa",         1, "fun [I] S",                    MBitoa         },
  { "itoh",         1, "fun [I] S",                    MBitoh         },

  { "ftoa",         1, "fun [F] S",                    MBftoa         },
  //$JI - Start - v4.a4 - New F type display functions
  { "ftoa5d",         1, "fun [F] S",                  MBftoa5d       },
  { "ftoa4d",         1, "fun [F] S",                  MBftoa4d       },
  { "ftoa3d",         1, "fun [F] S",                  MBftoa3d       },
  { "ftoa2d",         1, "fun [F] S",                  MBftoa2d       },
  { "ftoa1d",         1, "fun [F] S",                  MBftoa1d       },
  //$JI - End
  { "absf",         1, "fun [F] F",                    MBabsf         },
  { "PIf",          0, "fun [] F",                     MBPIf          },
  { "cos",          1, "fun [F] F",                    MBcos          },
  { "sin",          1, "fun [F] F",                    MBsin          },
  { "tan",          1, "fun [F] F",                    MBtan          },
  { "acos",         1, "fun [F] F",                    MBacos         },
  { "asin",         1, "fun [F] F",                    MBasin         },
  { "atan",         1, "fun [F] F",                    MBatan         },
  { "atan2",        2, "fun [F F] F",                  MBatan2        },
  { "Ef",           0, "fun [] F",                     MBEf           },
  { "log",          1, "fun [F] F",                    MBlog          },
  { "log10",        1, "fun [F] F",                    MBlog10        },
  { "exp",          1, "fun [F] F",                    MBexp          },
  { "pow",          2, "fun [F F] F",                  MBpow          },
  { "sqr",          1, "fun [F] F",                    MBsqr          },
  { "sqrt",         1, "fun [F] F",                    MBsqrt         },
  { "rootn",        2, "fun [F F] F",                  MBrootn        },
  //$BLG - v5.11: Add
  { "maxf",         2, "fun [F F] F",                  MBmaxf         },
  { "minf",         2, "fun [F F] F",                  MBminf         },

  { "tabtolist",    1, "fun [tab u0] [u0 r1]",         MBtabtolist    },
  { "tabtolistR",   1, "fun [tab u0] [u0 r1]",         MBtabtolistR   },
  { "listtotab",    1, "fun [[u0 r1]] tab u0",         MBlisttotab    },
  { "listtotabR",   1, "fun [[u0 r1]] tab u0",         MBlisttotabR   },

  { "atoi",         1, "fun [S] I",                    MBatoi         },
  { "atof",         1, "fun [S] F",                    MBatof         },
  { "htoi",         1, "fun [S] I",                    MBhtoi         },
  { "strlen",       1, "fun [S] I",                    MBstrlen       },
  { "strcat",       2, "fun [S S] S",                  MBstrcat       },
  { "strcmp",       2, "fun [S S] I",                  MBstrcmp       },
  { "strcmpi",      2, "fun [S S] I",                  MBstrcmpi      },
  { "listtostr",    1, "fun [[I r1]] S",               MBlisttostr    },
  { "strtolist",    1, "fun [S] [I r1]",               MBstrtolist    },
  { "substr",       3, "fun [S I I] S",                MBsubstr       },
  { "strdup",       1, "fun [S] S",                    MBstrdup       },
  { "nth_char",     2, "fun [S I] I",                  MBnth_char     },
  { "set_nth_char", 3, "fun [S I I] S",                MBset_nth_char },
  { "strcatn",      1, "fun [[S r1]] S",               MBstrcatn      },
  { "strfind",      3, "fun [S S I] I",                MBstrfind      },
  { "strfindi",     3, "fun [S S I] I",                MBstrfindi     }, 
  { "strlowercase", 1, "fun [S] S",                    MBstrlowercase },
  { "struppercase", 1, "fun [S] S",                    MBstruppercase },
  { "ctoa",         1, "fun [I] S",                    MBctoa         },
  { "mkscript",     1, "fun [Comm] S",                 MBmkscript     },
  { "strextr",      1, "fun [S] [[S r1] r1]",          MBstrextr      },
  { "strbuild",     1, "fun [[[S r1] r1]] S",          MBstrbuild     },
  { "strbuild2",    1, "fun [[[S r1] r1]] S",          MBstrbuild2    },
  { "lineextr",     1, "fun [S] [S r1]",               MBlineextr     },
  { "linebuild",    1, "fun [[S r1]] S",               MBlinebuild    },
  { "linebuild2",   1, "fun [[S r1]] S",               MBlinebuild2   },
  //$BLG - v5.11: Add
  { "strcatinit",		1, "fun [I] S",										 MBstrcatinit		},
  { "strcatblit",		2, "fun [S S] S",									 MBstrcatblit		},
  { "strcatlen",		1, "fun [S] I",										 MBstrcatlen	  },
  //$BLG - v5.24: Add
  { "strmd5",				1, "fun [S] S",										 MBstrmd5				},
  //$BLG - v5.2.06: Add
  { "strtrim",			1, "fun [S] S",										 MBstrtrim			},
  //$BLG - v5.3.01: Add
  { "lgetinfo",			2, "fun [[[S r1] r1] S] S",				 MBlgetinfo			},
  { "lgetinfoi",		2, "fun [[[S r1] r1] S] S",				 MBlgetinfoi		},
  { "lgetinfos",		2, "fun [[[S r1] r1] S] [S r1]",	 MBlgetinfos		},
  { "lcat",     		2, "fun [[u0 r1] [u0 r1]] [u0 r1]", MBlcat				},

  { "time",         0, "fun [] I",                     MBtime         },
  { "ctime",        1, "fun [I] S",                    MBctime        },
  { "gmtime",       1, "fun [I] [I I I I I I I I]",    MBgmtime       },
  { "localtime",    1, "fun [I] [I I I I I I I I]",    MBlocaltime    },

  { "hd",           1, "fun [[u0 r1]] u0",             MBhd           },
  { "tl",           1, "fun [[u0 r1]] [u0 r1]",        MBtl           },
  { "sizelist",     1, "fun [[u0 r1]] I",              MBsizelist     },
  { "nth_list",     2, "fun [[u0 r1] I] u0",           MBnth_list     },
  { "endlist",      2, "fun [[u0 r1] I] [u0 r1]",      MBendlist      },
  { "strtoweb",     1, "fun [S] S",                    MBstrtoweb     },
  { "webtostr",     1, "fun [S] S",                    MBwebtostr     },
  { "utf8tostr",    1, "fun [S] S",                    MButf8tostr    },
  { "strtoutf8",    1, "fun [S] S",                    MBstrtoutf8    },
  { "listmap",      2, "fun [fun [u0] u1 [u0 r1]] [u1 r1]", MBlistmap }, //$ FA(07/01/2001)

  { "mzip",         1, "fun [S] S",                    MZcompress     },
  { "munzip",       1, "fun [S] S",                    MZuncompress   },
  { "zip",          1, "fun [S] S",                    MGzip          },
  { "unzip",        1, "fun [S] S",                    MGunzip        },
#if !defined(SCOL_STRICT)
  { "_funlist",     1, "fun [Env] [Sold I I Sold r1]", FUNlist        },     
  { "_CtoScol",     1, "fun [Sold] S",                 FUNctoscol     },
#endif
  { "_isCommTooBig",1, "fun [Comm] I",                 isCommTooBig   },

  { "strcpy",       3, "fun [S I I] S",                 MBstrcpy       },//$LB (07/06/2004)
  { "memcpy",       5, "fun [S I S I I] I",             MBmemcpy       }//$LB (08/06/2004)

};


int SCOLloadBase(mmachine m)
{
  // Use new convention to package loader
  return PKhardpak2(m, "Scol", sizeof(base)/sizeof(base[0]), base);
}