//
// 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
//

#include "base.h"
#include "baselib.h"
#include "lexer.h"
#include "macros.h"
#include "interp.h"
#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>


extern "C" {
#include "include/vscol.h"     // declaration of MAXSOCKS
//$ ER(10/07/01): Put the following line in comment. Declaration of maxsock is done in vscol.h
// extern int maxsock;
#include "mmemory.h"
#include "mzip.h"
#include "loadpak.h"
#include "listlab.h"           // declaration of Mpushstrbloc()
}


#if defined(VERSION_WIN)
// 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);
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);

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

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

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


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



//
// 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)
    return MERROK;
  float f;
  // It should return nil in case of error instead of 0.0
  a2f((char*)&m->tape[(str>>1)+SizeHeader+1], &f);  //$ FA(13/07/2001)
  FSET(m->top[m->pp], f)
  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;
}

extern int maxsock; /*FLIC*/

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

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];
  memcpy((void*)cr,(void*)cp,np);
  memcpy((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=m->top[m->pp];
  if ((p==NIL)||(q==NIL))
    {
      if ((p==NIL)&&(q==NIL)) m->top[m->pp]=0;
      else if (p!=NIL) m->top[m->pp]=2;
      else m->top[m->pp]=-2;
      return 0;
    }
  cp=(char*)&m->tape[(p>>1)+SizeHeader+1];
  cq=(char*)&m->tape[(q>>1)+SizeHeader+1];
  m->top[m->pp]=strcmp(cp,cq)*2;
  return 0;
}

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

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

  n=m->tape[(p>>1)+SizeHeader];
  l=m->tape[(q>>1)+SizeHeader];
  for(i=i0;i<=l-n;i++)
  {
	  if (!memcmp(cp,cq+i,n))
	  {
		  m->top[m->pp]=i*2;
		  return 0;
	  }
  }
  m->top[m->pp]=NIL;
  return 0;
}

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

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

  n=m->tape[(p>>1)+SizeHeader];
  l=m->tape[(q>>1)+SizeHeader];
  for(i=i0;i<=l-n;i++)
  {
/*
#ifdef VERSION_WIN
          if (!_memicmp(cp,cq+i,n))
#else
*/
//$ FA(02/07/2001): Replace old strnicmp() by strncasecmp()
          if (!strncasecmp(cp,cq+i,n))
/*
#endif
*/
	  {
		  m->top[m->pp]=i*2;
		  return 0;
	  }
  }
  m->top[m->pp]=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];
      memcpy((void*)cr,(void*)(cp+a),b);
    }
  cr[b]=0;
  m->top[m->pp]=s+s+1;
  return 0;
}

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];
  memcpy((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)>>1;
  p=m->top[m->pp];
  if ((p==NIL)||(a==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)) m->top[m->pp]=0;
  else m->top[m->pp]=cp[a]*2;
  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];
          memcpy((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;
}


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

  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*/];
  k=2;
  while(((*p)!=32)&&(*p)) buf[k++]=*(p++);
  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];
  memcpy((void*)p,(void*)buf,k);

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

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

if (maxsock-50>MAXSOCKS-50) return -1; /*FLIC*/
  pp=m->pp;
  if (k=MBcom2(m))
  {
	m->pp=pp+1;
	MMset(m,0,NIL);
  }
  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];
  memcpy((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;

  p=m->top[m->pp];
  if (p==NIL) return 0;
  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;
  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;
  memcpy((void*)cr,(void*)cp,l-1);
  cr[l-1]=10;
  cr[l]=0;

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

static int MBstrlowercase(mmachine m)
{
  int k,l;
  char *p;

  if (MMget(m,0)==NIL) return 0;
  if (k=MBstrdup(m)) return k;
  l=MMsizestr(m,MMget(m,0)>>1);
  p=MMstartstr(m,MMget(m,0)>>1);
  for(k=0;k<l;k++) if ((p[k]>='A')&&(p[k]<='Z')) p[k]+='a'-'A';
  return 0;
}

static int MBstruppercase(mmachine m)
{
  int k,l;
  char *p;

  if (MMget(m,0)==NIL) return 0;
  if (k=MBstrdup(m)) return k;
  l=MMsizestr(m,MMget(m,0)>>1);
  p=MMstartstr(m,MMget(m,0)>>1);
  for(k=0;k<l;k++) if ((p[k]>='a')&&(p[k]<='z')) p[k]+='A'-'a';
  return 0;
}

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

  q=MMpull(m);
  p=m->top[m->pp];
  if ((p==NIL)||(q==NIL))
    {
      if ((p==NIL)&&(q==NIL)) m->top[m->pp]=0;
      else if (p!=NIL) m->top[m->pp]=2;
      else m->top[m->pp]=-2;
      return 0;
    }
  cp=(char*)&m->tape[(p>>1)+SizeHeader+1];
  cq=(char*)&m->tape[(q>>1)+SizeHeader+1];
//$ FA(02/07/2001): Replace old stricmp() by strcasecmp()
  m->top[m->pp]=strcasecmp(cp,cq)*2;
  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;
}

extern int maxsock; /*FLIC*/

static int MBstrextr(mmachine m)
{
  int pp;

if (maxsock*2>MAXSOCKS*2) return -1; /*FLIC*/
  pp=m->pp;
  if (MBstrextr2(m))
    {
      m->pp=pp;
      m->top[m->pp]=NIL;
    }
  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;
}

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)
        {
          memcpy(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)
        {
          memcpy(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;
}


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



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


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         },
  { "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        },

  { "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   },

  { "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     },
  { "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   }
};


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