/*     
      SCOL SYSTEM . Magma 1.0 . 1996 . Sylvain HUET

         scolsys.cpp : routines systeme de scol
*/
// Modification history:
//$ FA(28/05/2001): Replaced call to SCexeccomm0() by SCexeccomm(), which is 
//                  completely equivalent
//$ FA(28/05/2001): Promoted to C++ implementation file
//$ FA(28/05/2001): Rewrite SCscript() and SCscriptc() to use Script class methods
//$ FA(01/06/2001): Comment MMpull() after call to SCexeccomm()
//$ FA(06/06/2001): Includes baselib.h 
//$ FA(18/06/2001): Debugger integration. Add channel id and channel user name support.
//$ FA(19/06/2001): Debugger integration. Close debugger's channel in SCclosemachine().
//                  Send notification when a package is removed
//
//$ LB(20/06/2001): add SCdefinesocksVersion and SCdefinesocksAuthentication function bodys,
//                  to make scol able to specifiy socks protocol parameters 
//                  (protocol version and the need of authentication)
//
//$ ER(09/07/2001): Rewrite testLicense to decrypt the parameters from the license number
//					Turn #ifdef SERVERM in the test of MUTUALISE in setserver
//$ FA(16/07/2001): Use h2i() function as a replacement for Mgethx()
//$ FA(23/07/2001): Comment out SCsetsocket(m, c, -1)
//$ FA(27/08/2001): Print a message into the log indicating the max number of sockets
//                  the license allows
//$ FA(12/11/2001): Replace SCOL_DEBUGGER_AWARE by INCLUDE_DEBUGGER
//$ FA(17/01/2002): Revise and rewrite SCdestroychannel(). Extra notify parameter is used
//                  in order to know if '_closed' callback needs to be called. Modify all
//                  invocations to take into account of the extra parameter, in particular
//                  SCchanneldown() which should set the notify parameter to 1.
//$ FA(30/01/2002): SCremovepkg() modified to return nil when the user reaches the base environment
//$ FA(08/04/2002): Correct SCfreememory(), so that it returns a positive value
//
//$ LB (30/05/2002) : testlicence function : make the ClubHouse Server accept an unlimited number of connections
//

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>

extern "C" {
#include "include/vscol.h"
}
#if defined(VERSION_X11) || defined(VERSION_NOX)
#include <sys/time.h>
#include <unistd.h>
#endif

extern "C" {
#include "mmemory.h"
#include "mbytec.h"
#include "listlab.h"
#include "loadpak.h"
#include "mainscol.h"
#include "scol.h"
#include "scolpack.h"
#include "scolsign.h"
#include "fifo.h"
#include "include/socket.h"
//$LB : use socks protocol interface
#include "include/socks.h"
//
#include "include/common.h"
#include "scolobj.h"
}
#include "baselib.h"
//$ FA(08/11/2000): Use debugger interface
#include "debug.h"
//
#include "macros.h"
#include "scolsys.h"
//$ FA(28/05/2001): Use Script class interface
#include "script.h"
//
//$ ER(09/07/01): Use rsa library
#include "rsa.h"
#include "lexer.h"


static int unplugged_sock=FirstUnplugged;
extern "C" {
int (*LocalMessage)(char *buf);
int activeChannel=0;
char forcedIP[64];
int flagLicense;
int SClocalIPnumber;

//$ ER(09/07/01) : c'est utile ?
extern char execpath[1024];
/*
extern int MAXSOCKS;
extern int MAXSOCKSE;
extern int maxsock;*/

int LoadUsmIni(char* cmdline);
int SCdefinesocks2(char *socks,char *mask);
}

#ifdef SERVER
#define KEY2 "11b3e"
#define KEY4 "d243f"
#endif



//$ FA(28/05/2001): Rewritten. Use new Script class.
int SCscript(mmachine m)
// Executes a script on the current channel
// [0]: string containing the script text
{
  int res = MERROK;
  if (MMget(m, 0) != NIL) {
    Script script(m, MMstartstr(m, MMget(m, 0)>>1));
    res = script.execute();
  }
  MMset(m, 0, 0);
  return res;
}


//$ FA(28/05/2001): Rewritten. Use new Script class.
int SCscriptc(mmachine m)
// Executes a script on a specified channel
// [1]: channel where script should execute
// [0]: string containing the script text
{
  if (MMget(m, 0) == NIL || MMget(m, 1) == NIL) {
    MMpull(m);
    MMset(m, 0, 0);
    return MERROK;
  }

  // Switch to new channel
  int chn = MMget(m, 1);
  MMset(m, 1, MMgetglobal(m, OFFSCCUR));  // save current channel on the stack
  MMsetglobal(m, OFFSCCUR, chn);

  // Execute script
  Script script(m, MMstartstr(m, MMpull(m)>>1));
  int res = script.execute();

  // Restore previous channel
  MMsetglobal(m, OFFSCCUR, MMget(m, 0));
  MMset(m, 0, 0);
  return res;
}


/* creation d'un canal
 en 2 : corresp 
 en 1 : script
 en 0 : env */
int SCopenchannelbis(mmachine m)
{
  int k,base,s,ip,port,proxy;
  char buf[128];

  base=MMgetPP(m);
  if (MMgetbase(m,base,1)==NIL) return MERRTYP;

  if (k=SCmakefifo(m)) return k;                  /* bloc.fifo */
  if (MMpush(m,MMgetbase(m,base,1))) return MERRMEM;  /* env.canal */
//$ FA(08/11/2000)
  SECHECK(SEPUSH(m, NIL));              // user channel name (unspecified)
//$ FA(23/11/2000)
  SECHECK(SEPUSH(m, SEI2W(chnID++)));   // assign channed id
//
  if (MMpush(m,SIZECHAN*2)) return MERRMEM;
  if (k=MBdeftab(m)) return k;

  MMsetglobal(m,OFFSCCUR,MMget(m,0));
  if (MMgetbase(m,base,3)==NIL)
    {
      MMechostr(MSKDEBUG,"unplugged channel %d\n",unplugged_sock);  
      SCsetsocket(m,MMgetglobal(m,OFFSCCUR),unplugged_sock--);
      if (k=Mpushstrbloc(m,"unplugged")) return k;
      SCsetsockname(m,MMgetglobal(m,OFFSCCUR)); /* reglage du nom */
    }
  else
    {
      /* lancer la connexion socket */
      s=SCKconnect(MMstartstr(m,MMgetbase(m,base,3)>>1),&ip,&port,&proxy);
      if (s<0)
	{
	  if (MMpush(m,NIL)) return MERRMEM;
	  return 0;
	}
      if (proxy) SCsetproxy(m,MMgetglobal(m,OFFSCCUR));
      SCsetsocket(m,MMgetglobal(m,OFFSCCUR),s);
      if (k=Mpushstrbloc(m,SCKgetstringbyip(buf,ip,port))) return k;
      SCsetsockname(m,MMgetglobal(m,OFFSCCUR)); /* reglage du nom */
    }

  if (k=SCaddcanal(m)) return k;

  MMset(m,0,MMgetbase(m,base,2));
  if (k=SCscript(m)) return k;
  if (MMpull(m)) return MERRTYP;

  return MMpush(m,MMgetglobal(m,OFFSCCUR));
}

int SCopenchannel3(mmachine m)
{
  int k,base;

  if (MMpush(m,MMgetglobal(m,OFFSCCUR))) return MERRMEM;
  base=MMgetPP(m);
  k=SCopenchannelbis(m);
  MMsetglobal(m,OFFSCCUR,MMgetbase(m,base,0));
  if (k)
    MMsetbase(m,base,3,NIL);
  else
    MMsetbase(m,base,3,MMget(m,0));
  MMsetPP(m,base+3);
  return k;
}

int SCopenchannel(mmachine m)
{
  char *p;
  
  if (MMget(m,2)!=NIL)
    {
      p=MMstartstr(m,MMget(m,2)>>1);
      if( ((ScolRights&C_RIGHTS)==0)||
          ( ((ScolRights&D_RIGHTS)==0)&&(*p!=':')) )
	{
		  MMpull(m);
	      MMpull(m);
          MMset(m,0,NIL);
          return 0;
	}
    }
  else if (SCgetnbsocketu(m)>=MAXSOCKSU)
  {
	  MMpull(m);
      MMpull(m);
      MMset(m,0,NIL);
      return 0;
  }


  if (MMget(m,0)==NIL) MMset(m,0,MMgetglobal(m,OFFSCBASE));

  MMechostr(MSKDEBUG,"ouverture d'un canal\n");
  return SCopenchannel3(m);
}

/* Destruction de la structure canal */
int SCdestroychannel(mmachine m, int chn, int notify)
// FA  17/01/2002  Revised and rewritten
{
  int res;
  // Do nothing if channel is null
  if (chn == NIL) 
    return MERROK;
  // The order of the following steps needed to close a channel is significant
  // (1) Remove the channel from the list
  SCdelcanal(m, chn);
  // (2) Close socket and mark socket field as closed
  SCKclose(SCgetsocket(m, chn));
  SCsetsocket(m, chn, -1);
  // (3) If requested, call the '_closed' callback
  MMpush(m, chn);
  if (notify && (res = SCexeccomm(m, "_closed"))) 
    return res;
  // (4) Unlink channel environment
  chn = MMpull(m);
  MMstore(m, chn>>1, OFFCHANENV, NIL);
  // (5) Remove all channel objects and return to caller
  return OBJdelChn(m, chn);
}


/* Fermeture du canal courant */
int SCclosechannel(mmachine m)
{
  int chn = MMgetglobal(m, OFFSCCUR);  /* lire l'environnement courant */
  if (chn == NIL) 
    return MERRTYP;
//$ FA(17/01/2002): Call to SCdestroychannel() with extra 'notify' argument = 0
  SCdestroychannel(m, chn, 0);
//
  return MMpush(m, 0);
}

/* Fermeture de la machine */
int SCclosemachine(mmachine m)
{
	int c;

//  MMechostr(1,"_closemachine\n");
//$ FA(19/06/2001): Close debugger's channel
#if defined(INCLUDE_DEBUGGER)
  DBGCloseChannel(m);
#endif
//
  while(MMgetglobal(m,OFFSCCHAN)!=NIL)
  {
	  c=MMfetch(m,MMgetglobal(m,OFFSCCHAN)>>1,0);
//$ FA(17/01/2002): Call to SCdestroychannel() with extra 'notify' argument = 0
	  SCdestroychannel(m, c, 0);
//
  }
  MMechostr(MSKDEBUG,"delete servers\n");
  while(MMgetglobal(m,OFFSCSERVER)!=NIL)
  {
	  c=MMfetch(m,MMgetglobal(m,OFFSCSERVER)>>1,0);
	  MMechostr(MSKDEBUG,"close one server\n");
      SCKcloseserver(SCgetsrvsocket(m,c));
	  SCdelserver(m,c);
  }
  m->err=MERRCLOSE;
  return MMpush(m,0);
}

/* gestion de fermeture accidentelle du canal courant */
int SCchanneldown(mmachine m)
{
  int chn;
//$ FA(17/01/2002): Destroy current channel and execute _closed callback
  if ((chn = MMgetglobal(m, OFFSCCUR)) == NIL) 
    return MERRTYP;
  SCdestroychannel(m, chn, 1);
//
  return 0;
}

/* fermeture d'un canal de l'appli */
int SCkillchannel(mmachine m)
{
//$ FA(17/01/2002): Call to SCdestroychannel() with extra 'notify' argument = 0
  SCdestroychannel(m, MMget(m, 0), 0);
//
  MMset(m, 0, 0);
  return MERROK;
}

/* lit le nom du canal */
int SCchannelname(mmachine m)
{
  if (MMget(m,0)==NIL) return 0;
  return SCgetsockname(m,MMpull(m));
}

/* lit l'adresse IP du canal */
int SCchannelIP(mmachine m)
{
  char buf[256];
  int i,l,k;

  if (MMget(m,0)==NIL) return 0;
  if (k=SCgetsockname(m,MMpull(m))) return MERRMEM;
  if (MMget(m,0)==NIL) return 0;
  strcpy(buf,MMstartstr(m,MMpull(m)>>1));
  l=strlen(buf);
  for(i=0;i<l;i++) if (buf[i]==':') buf[i]=0;
  if (k=Mpushstrbloc(m,buf)) return k;
  return 0;
}

/* lit le numero de port du canal */
int SCchannelport(mmachine m)
{
  char *p;
  int k;

  if (MMget(m,0)==NIL) return 0;
  if (k=SCgetsockname(m,MMpull(m))) return MERRMEM;
  if (MMget(m,0)==NIL) return 0;
  p=MMstartstr(m,MMpull(m)>>1);
  while(*p)
    {
      if ((*p)==':') return MMpush(m,atoi(p+1)*2);
      p++;
    }
  return MMpush(m,-1*2);
}

/* retourne le nom de l'hote */
int SChostname(mmachine m)
{
  char buf[1204];

  return Mpushstrbloc(m,SCKhostname(buf));
}

/* retourne l'adresse IP de l'hote */
int SChostIP(mmachine m)
{
  char buf[1204];
  int i;

  if (forcedIP[0]) return Mpushstrbloc(m,forcedIP);
  i=SClocalIPnumber;
  if ((i<0)||(i>=SCKgetnbIP()))i=0;
  SCKgetnthIP(buf,i);
  return Mpushstrbloc(m,buf);
}

/* definit l'index d'IP locale */
int SCsetLocalIPnumber(mmachine m)
{

	int i;
	i=MMget(m,0)>>1;
	if ((i<0)||(i>=SCKgetnbIP())) i=0;
	SClocalIPnumber=i;
	return 0;
}


/* retourne toutes les adresses IP de l'hote */
int SChostIPall(mmachine m)
{
	char buf[64];
	int i,n,k;
	
	n=SCKgetnbIP();
	for(i=0;i<n;i++)
	{
		SCKgetnthIP(buf,i);
		if ((k=Mpushstrbloc(m,buf))) return k;
	}
	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;
    }
	return 0;
}


/* DNS synchrone */
int SCgethostbyname(mmachine m)
{
  char buf[1204];
  int k;

  if (MMget(m,0)==NIL) return 0;
  if (SCKgethostbyname(buf,MMstartstr(m,MMpull(m)>>1))==NULL)
    return MMpush(m,NIL);
  if (k=Mpushstrbloc(m,buf)) return k;
  return 0;
}

/* DNS synchrone name -> IP */
int SCgetnamebyIP(mmachine m)
{
  char buf[1204];
  int k;

  if (MMget(m,0)==NIL) return 0;
  if (SCKgetnamebyIP(buf,MMstartstr(m,MMpull(m)>>1))==NULL)
    return MMpush(m,NIL);
  if (k=Mpushstrbloc(m,buf)) return k;
  return 0;
}

/* canal courant */
int SCchannel(mmachine m)
{
  return MMpush(m,MMgetglobal(m,OFFSCCUR));
}

/* changement de canal courant */
int SCsetchannel(mmachine m)
{
  int p;

  p=MMget(m,0);
  if (p!=NIL) MMsetglobal(m,OFFSCCUR,p);
  return 0;
}

/* nom du premiet package d'un environnement */
int SCenvfirstname(mmachine m)
{
  int p;
  char path[SIZESIGN];

  p=MMget(m,0);
  if (p==NIL) return 0;
  strcpy(path,(char*)MMstart(m,MMfetch(m,MMfetch(m,p>>1,OFFLVAL)>>1,OFFPKNAME)>>1));
  MMpull(m);
  return Mpushstrbloc(m,path);
}

/* lecture de l'environnement lie a un canal */
int SCenvchannel(mmachine m)
{
  int t;

  t=MMget(m,0);  /* canal argument */
  if (t==NIL) return 0;
  MMset(m,0,MMfetch(m,t>>1,OFFCHANENV));
  return 0;
}

/* retirer un package d'un environnement */
int SCremovepkg(mmachine m)
{
//$ FA(19/06/2001): Notify debugger that a package has been removed!
#if defined(INCLUDE_DEBUGGER)
  int res;
  SECHECK(SEPUSH(m, SEHEAD(m, SEW2P(SEGETTOP(m, 0)))));
  if (res = DBGNotifyPackageRemoved(m))
    return res;
#endif
//$ FA(30/01/2002): We stop when we find the beginning of the base environment
  if (SEGETROOT(m, OFFSCBASE) == SETAIL(m, SEW2P(SEGETTOP(m, 0)))) {
    SESETTOP(m, 0, NIL);
    return MERROK;
  }
//
  return MBtl(m);
}

/* creation d'une appli a partir du canal courant */
int SCsetenv(mmachine m)
{
  int e,t;

  e=MMpull(m);
  if (e==NIL) e=MMgetglobal(m,OFFSCBASE);
  t=MMget(m,0);  /* canal argument */
  if (t==NIL) return 0;
  MMstore(m,t>>1,OFFCHANENV,e);
  MMset(m,0,0);
  return 0;
}

/* definition du serveur
 en 2 : env
 en 1 : numero de port
 en 0 : script */
//$ ER(09/07/01) turn #ifdef SERVERM to test of MUTUALISE
int SCsetserver(mmachine m)
{
  int s,port,k;
  time_t ts;

#ifdef SERVER
  if ((!ScolSuper)&&(!flagLicense))
    {
      MMechostr(MSKRUNTIME,"cannot start server : no licence\n");
      return MERRTYP;
    }
#endif
  if ((ScolRights&S_RIGHTS)==0)
    {
      MMpull(m);
      MMpull(m);
      MMset(m,0,NIL);
      return 0;
    }
  
  if (MMget(m,2)==NIL) MMset(m,2,MMgetglobal(m,OFFSCBASE));

  /* ouvrir une socket d'ecoute sur le port donne' en parametre */
  port=MMget(m,1)>>1;
  if ((s=SCKstartserver(port))<0)
    {
      MMpull(m);
      MMpull(m);
      MMset(m,0,NIL);
      return 0;
    }
  if (MMpush(m,s*2)) return MERRMEM;
  time(&ts);
  if (MMpush(m,MMget(m,3))) return MERRMEM;
  if (MMpush(m,port*2)) return MERRMEM;
  if (MMpush(m,ts*2)) return MERRMEM;
  if (MMpush(m,SIZESRV*2)) return MERRMEM;
  if (k=MBdeftab(m)) return k;
  MMset(m,2,MMget(m,0));
  MMset(m,1,MMget(m,0));
  MMpull(m);
  if (k=SCaddserver(m)) return k;

#ifdef SERVER
  if ((!ScolSuper) && (MUTUALISE))
	  SCsendCapacity(m);
#endif
 
  return 0;
}

/* fermeture du serveur */
int SCcloseserver(mmachine m)
{
  int s,t;

  t=MMget(m,0);
  if (t==NIL) return 0;

  /* fermer la socket d'ecoute */
  s=SCgetsrvsocket(m,t);
  SCKcloseserver(s);
  SCdelserver(m,t);
  MMset(m,0,0);
  return 0;
}


/* definition d'un serveur udp
 en 2 : env
 en 1 : numero de port
 en 0 : script */
int SCsetUDPserverbis(mmachine m)
{
  int k,base,s,p;

  base=MMgetPP(m);
  if (MMgetbase(m,base,3)==NIL) return MERRTYP;

  if (k=SCmakefifo(m)) return k;                  /* bloc.fifo */
  if (MMpush(m,MMgetbase(m,base,3))) return MERRMEM;  /* env.canal */
//$ FA(08/11/2000)
  SECHECK(SEPUSH(m, NIL));              // user channel name (unspecified)
//$ FA(23/11/2000)
  SECHECK(SEPUSH(m, SEI2W(chnID++)));   // assign channed id
//
  if (MMpush(m,SIZECHAN*2)) return MERRMEM;
  if (k=MBdeftab(m)) return k;

  MMsetglobal(m,OFFSCCUR,MMget(m,0));

  /* lancer la connexion socket */
  p=MMgetbase(m,base,2)>>1;

  if (p>=0) s=SCKstartudpserver(p);
  if ((p<0)||(s<0))
    {
      if (MMpush(m,NIL)) return MERRMEM;
	  return 0;
	}
  SCsetudp(m,MMgetglobal(m,OFFSCCUR));
  SCsetsocket(m,MMgetglobal(m,OFFSCCUR),s);

  if (k=SCaddcanal(m)) return k;

  MMset(m,0,MMgetbase(m,base,1));
  if (k=SCscript(m)) return k;
  if (MMpull(m)) return MERRTYP;

  return MMpush(m,MMgetglobal(m,OFFSCCUR));
}

int SCsetUDPserver(mmachine m)
{
  int k,base;

  if (MMpush(m,MMgetglobal(m,OFFSCCUR))) return MERRMEM;
  base=MMgetPP(m);
  k=SCsetUDPserverbis(m);
  MMsetglobal(m,OFFSCCUR,MMgetbase(m,base,0));
  if (k)
    MMsetbase(m,base,3,NIL);
  else
    MMsetbase(m,base,3,MMget(m,0));
  MMsetPP(m,base+3);
  return k;
}

/* emission d'un message udp */
int SCsendudp(mmachine m)
{
  int l;
  char *p;

  if ((MMget(m,0)==NIL)||(MMget(m,1)==NIL))
    {
      MMpull(m);
      MMset(m,0,0);
      return 0;
    }
  p=(char*)MMstart(m,MMget(m,0)>>1);
  l=(p[0]&255)+((p[1]&255)<<8)+2;
  
  SCKsendudp(MMstartstr(m,MMget(m,1)>>1),p,l);
  MMpull(m);
  MMset(m,0,0);
  return 0;
}

/* emission d'un message udp en spécifiant la socket */
int SCsendudpchn(mmachine m)
{
  int l;
  char *p;

  if ((MMget(m,0)==NIL)||(MMget(m,1)==NIL)||(MMget(m,2)==NIL))
    {
      MMpull(m);
      MMpull(m);
      MMset(m,0,0);
      return 0;
    }
  p=(char*)MMstart(m,MMget(m,0)>>1);
  l=(p[0]&255)+((p[1]&255)<<8)+2;

  SCKsendudpchn(SCgetsocket(m,MMget(m,2)),MMstartstr(m,MMget(m,1)>>1),p,l);
  MMpull(m);
  MMpull(m);
  MMset(m,0,0);
  return 0;
}

/* recuperation de la duree d'un canal */
int SCchanneltime(mmachine m)
{
  int c;
  
  if ((c=MMget(m,0))==NIL) return 0;
  MMset(m,0,SCgetchanneltime(m,c)*2);
  return 0;
}

/* recuperation de la duree d'un canal */
int SCservertime(mmachine m)
{
  int c;
  
  if ((c=MMget(m,0))==NIL) return 0;
  MMset(m,0,SCgetservertime(m,c)*2);
  return 0;
}


/* emission d'un message */
int SCon(mmachine m)
{
  int k,z;

  if ((MMget(m,0)==NIL)||(MMget(m,1)==NIL))
    {
      MMpull(m);
      MMset(m,0,0);
      return 0;
    }
  z=MMget(m,1);         /* echange environnement */
  MMset(m,1,MMgetglobal(m,OFFSCCUR));
  MMsetglobal(m,OFFSCCUR,z);
  k=SCsendpile(m);
  if (k) return k;
  MMsetglobal(m,OFFSCCUR,MMget(m,0));      /* echange environnement */

  MMset(m,0,0);
  return 0;
}

/* emission d'un message vers activeX */
int SConX(mmachine m)
{
	if ((LocalMessage)&&(MMget(m,0)!=NIL))
	{
		MMechostr(MSKTRACE,">>onX : %s\n",((char*)MMstartstr(m,MMget(m,0)>>1)-2));
		(*LocalMessage)((char*)MMstartstr(m,MMget(m,0)>>1)-2);
	}
	return 0;
}

/* definition du canal ActiveX */
int SCsetX(mmachine m)
{
	if (MMget(m,0)==NIL) return 0;
	activeChannel=SCgetsocket(m,MMget(m,0));
	return 0;
}


/* comptage des messages en attente dans la fifo d'un canal */
int SCwaitingfifo(mmachine m)
{
  int c,n;
  
  if ((c=MMget(m,0))==NIL) return 0;
  c>>=1;
  n=0;
  if ((c=MMfetch(m,c,OFFCHANFIFO))!=NIL)
    {
      c>>=1;
      c=MMfetch(m,c,FIFOOUT)>>1;
      while(c!=NIL)
	{
          n++;
          c=MMfetch(m,c,OFFLNEXT)>>1;
	}
    }   
  MMset(m,0,n*2);
  return 0;
}

/* taille des messages en attente dans la fifo d'un canal */
int SCsizewaitingfifo(mmachine m)
{
  int c,n,v;
  char *p;
  
  if ((c=MMget(m,0))==NIL) return 0;
  c>>=1;
  n=0;
  if ((c=MMfetch(m,c,OFFCHANFIFO))!=NIL)
    {
      c>>=1;
      c=MMfetch(m,c,FIFOOUT)>>1;
      while(c!=NIL)
	{
          v=MMfetch(m,c,OFFLVAL)>>1;
          p=(char*)MMstart(m,v);
          n+=(p[0]&255)+((p[1]&255)<<8);
          c=MMfetch(m,c,OFFLNEXT)>>1;
	}
    }   
  MMset(m,0,n*2);
  return 0;
}

/* reglage de la limite d'une la fifo */
int SCsetsizefifo(mmachine m)
{
  int c,n;
  
  n=MMpull(m);
  if ((c=MMget(m,0)>>1)==NIL) return 0;
  if ((c=MMfetch(m,c,OFFCHANFIFO)>>1)==NIL) return 0;
  if (n!=NIL) n=((n>>3)<<1);
  MMstore(m,c,FIFOMAX,n);
  return 0;
}

/* lecture des droits de la machine */
int SCgetrights(mmachine m)
{
  return MMpush(m,ScolRights*2);
}

/* restriction des droits de la machine */
int SCsetrights(mmachine m)
{
  int k;
    
  k=MMpull(m);
  if (k==NIL) return MMpush(m,NIL);
  ScolRights&=(k>>1);
  return MMpush(m,ScolRights*2);
}
    
/* lecture de la taille de la memoire */
int SCsizememory(mmachine m)
{
  return MMpush(m,m->sizetape*2);
}

/* lecture de la taille disponible en memoire */
int SCfreememory(mmachine m)
{
	MMgc(m);
    return MMpush(m,(m->sizetape-m->topheap+m->pp)*2); //$ FA(08/04/2002)
}



//$LB (22/04/2002) : avoid negative value of tickcount
#if defined(VERSION_X11) || defined(VERSION_NOX)
int _globalTickcount = 0;
#endif


/* lecture du nombre de millisecondes ecoulees */
int SCtickcount(mmachine m)
{
#ifdef VERSION_WIN
  return MMpush(m,GetTickCount()*2);
#endif
#if defined(VERSION_X11) || defined(VERSION_NOX)
  struct timeval tm;
  int t;

  gettimeofday(&tm,NULL);
  t=(tm.tv_sec*1000)+(tm.tv_usec/1000);
  //$LB (22/04/2002)
  return MMpush(m, SEI2W(t - _globalTickcount));;
#endif
#ifdef VERSION_MAC
  TODO
#endif
}

/* lancement d'une machine SCOL */
int SCnewmachine(mmachine m)
{
  int size,rights,k;
  char buf[1024],srights[16],sizestr[16];
  char *p;
  char *q;
    
  size=MMpull(m);
  rights=MMpull(m);
  if ((MMget(m,1)==NIL)||(MMget(m,0)==NIL))
    {
      MMpull(m);
      MMset(m,0,NIL);
      return 0;
    }
  if (k=MBstrtoweb(m)) return k;
  if (size==NIL) size=m->sizetape;
  else size>>=1;
  if (rights==NIL) rights=ScolRights;
  else rights=(rights>>1)&ScolRights;
  if (Firstpack==Cachepack) rights&=~M_RIGHTS;
  SCendcodeRights(srights,rights);
    
  p=MMstartstr(m,MMpull(m)>>1);
  q=MMstartstr(m,MMget(m,0)>>1);
  sprintf(sizestr,"%d",size);
  sprintf(buf,"$%s$%s",q,p);
  k=StartUSM(buf,srights,sizestr);
  MMset(m,0,k*2);
  return 0;
}

int SCnewmachineS(mmachine m)
{
  int size,rights,k;
  char buf[1024],srights[16],sizestr[16];
  char *q;

  size=MMpull(m);
  rights=MMpull(m);
  if (MMget(m,0)==NIL)
  {
	  k=StartUSM(NULL,NULL,NULL);
	  MMset(m,0,k*2);
	  return 0;
  }
  if (size==NIL) size=m->sizetape;
  else size>>=1;
  if (rights==NIL) rights=ScolRights;
  else rights=(rights>>1)&ScolRights;
  if (Firstpack==Cachepack) rights&=~M_RIGHTS;
  SCendcodeRights(srights,rights);
    
  q=MMstartstr(m,MMget(m,0)>>1);
  sprintf(sizestr,"%d",size);
  sprintf(buf,"\"%s\"",q);
  k=StartUSM(buf,srights,sizestr);
  MMset(m,0,k*2);
  return 0;
}

/* definition de la socket life */
int SCsetsocklife(mmachine m)
{
  int c;

  if (socklife!=-1) return 0;
  if ((c=MMget(m,0))==NIL) return 0;
  socklife=SCgetsocket(m,c);
  return 0;
}

/* affichage de la console */
int SCshowconsole(mmachine m)
{
  ScolShowConsole();
  return MMpush(m,0);
}

/* effacement de la console */
int SChideconsole(mmachine m)
{
  ScolHideConsole();
  return MMpush(m,0);
}

/* lancement d'un browser http */
int SCopenbrowserhttp(mmachine m)
{
  if (MMget(m,0)==NIL) return 0;
  StartHTTP(MMstartstr(m,MMget(m,0)>>1),1);
  return 0;
}

/* lancement d'un browser http a partir d'un fichier local */
int SCopenbrowserhttpP(mmachine m)
{
  int ask=1;
  if (MMget(m,0)==NIL) return 0;
  if (ScolSuper) ask=0;
  StartHTTP(MMstartstr(m,MMget(m,0)>>1),ask);
  return 0;
}

/* numero de version de la machine scol */
int SCversion(mmachine m)
{
  return MMpush(m,VERSION_N*2);
}

/* nom de version de la machine scol */
int SCversionname(mmachine m)
{
  return Mpushstrbloc(m,VERSION_NAME);
}

int SCsizeress(mmachine m)
{
  int p,n;
  n=0;
  p=MMgetglobal(m,OFFSCRESS);
  while(p!=NIL)
    {
      p>>=1;
      n++;
      p=MMfetch(m,p,OFFLNEXT);
    }
  return n;
}

/* lecture d'une variable ressource */
int SCfindress(mmachine m,char *name,int *prev)
{
  int p,q;

  *prev=NIL;
  p=MMgetglobal(m,OFFSCRESS);
  while(p!=NIL)
    {
      p>>=1;
      q=MMfetch(m,p,OFFLVAL)>>1;
      if ((q!=NIL)&&
	  (!strcmp(name,MMstartstr(m,MMfetch(m,q,0)>>1) )) )
	return p;
      *prev=p;
      p=MMfetch(m,p,OFFLNEXT);
    }
  return NIL;
}

/* lecture d'une variable ressource */
int SCgetress(mmachine m)
{
  int p,q;
  char *name;

  if (MMget(m,0)==NIL) return 0;
  name=MMstartstr(m,MMget(m,0)>>1);
  p=SCfindress(m,name,&q);
  if (p==NIL)
    {
      MMset(m,0,NIL);
      return 0;
    }
  q=MMfetch(m,p,OFFLVAL)>>1;
  MMset(m,0,MMfetch(m,q,1));
  return 0;
}

//$ ER(09/07/01) : rewrite of testLicense to decrypt the parameters from the license number
//				   Initialisation of maxsock, MAXSOCKS, MAXSOCKSE, Debut, Period, MUTUALISE
int testLicense(mmachine m)
{
#ifdef SERVER

//$ LB (30/05/2002) : make the ClubHouse Server accept an unlimited number of connections
#ifdef CLUBHOUSE_SERVER
	MAXSOCKS = 1000001;
	maxsock = MAXSOCKS;
	MAXSOCKSE=1000;
    MMechostr(MSKTRACE, "ClubHouse Server allows for a maximum of %d sockets.\n", maxsock);
#else


	char buf[16];
	char MyBuf[21];
	char *p;
	int i,x,s,o, Param, Id;
	short MyShort[16];
	char PublicKey[21];

	p=MMstartstr(m,MMget(m,0)>>1);
	if (MMsizestr(m,MMget(m,0)>>1)!=20) return -1;
	s=0; o=0;
	for(i=0;i<4;i++)
	{
		strncpy(buf,p+4*i,4);
		buf[4]=0;
    if (!h2i(buf, &x))  //$ FA(16/07/2001)
      return -1;
		s+=x;
		o|=x;
	}
	strncpy(buf,p+16,4);
	strcpy(MyBuf,p);
	MyBuf[20]=0;
    buf[4]=0;
  if (!h2i(buf, &x))    //$ FA(16/07/2001)
    return -1;
	s&=0xffff;

	sprintf( PublicKey, "%s%s%s%s", KEY1, KEY2, KEY3, KEY4 );
	convertKeycod(MyBuf, PublicKey, MyShort );
	Periode=getPeriodeFromKeycode( MyBuf, PublicKey );
	Debut=getDateFromKeycode(MyBuf, PublicKey );
	Param=getParamFromKeycode(MyBuf, PublicKey );
	Id=getIdFromKeycode(MyBuf, PublicKey );
	if (Id < 0) return -1;

/*	convertKeycod(MyBuf, "6360f 859a8 0e836 0cfe9", MyShort );
	Periode=getPeriodeFromKeycode( MyBuf, "6360f859a80e8360cfe9" );
	Debut=getDateFromKeycode(MyBuf, "6360f859a80e8360cfe9" );
	Param=getParamFromKeycode(MyBuf, "6360f859a80e8360cfe9" );*/

	MAXSOCKS=Param>>1;
	maxsock=Param>>1;
	MAXSOCKSE=1000;
	MUTUALISE=(Param&1);
    MMechostr(MSKTRACE, "Your license number allows for a maximum of %d sockets.\n", maxsock);
#endif
#else
#ifdef SE_P10
	MAXSOCKS=1000001;
	MAXSOCKSE=1000;
#endif

#ifdef SE_D10
	MAXSOCKS=1000001;
	MAXSOCKSE=1000;
#endif

	maxsock=MAXSOCKS;
#endif
	 return 0;
}

/* ecriture d'une variable ressource */
int SCsetress(mmachine m)
{
  int q,prev,k;
  char buf[32];

  MMechostr(MSKRUNTIME,"Debut multiress\n");
  if (MMget(m,1)==NIL)
    {
      MMpull(m);
      return 0;
    }

  if (MMget(m,0)==NIL)
    {
      if (!strcmp(MMstartstr(m,MMget(m,1)>>1),"License")) flagLicense=1;
      q=SCfindress(m,MMstartstr(m,MMget(m,1)>>1),&prev);
      if (q!=NIL)
	{
	  if (prev==NIL) MMsetglobal(m,OFFSCRESS,MMfetch(m,q,OFFLNEXT));
	  else MMstore(m,prev,OFFLNEXT,MMfetch(m,q,OFFLNEXT));
	}
      MMpull(m);
      MMset(m,0,NIL);
      return 0;
    }
  if (!strcmp(MMstartstr(m,MMget(m,1)>>1),"License"))
    {
      if (testLicense(m))
	{
	  MMechostr(MSKRUNTIME,">>>bad license number<<<\n");
	  return MERRTYP;
	}
      
      if ((!ScolSuper)&&(!flagLicense))
	{
	  strncpy(buf,MMstartstr(m,MMget(m,0)>>1),16);
	  buf[16]=0;
	  SPrefinePack(Cachepack,buf);
	  MMechostr(1,"new cache : %s\n",Cachepack->path);
	}
      flagLicense=1;
    }
  q=SCfindress(m,MMstartstr(m,MMget(m,1)>>1),&prev);
  if (q!=NIL) MMstore(m,MMfetch(m,q,OFFLVAL)>>1,1,MMget(m,0));
  else
    {
      if (MMpush(m,MMget(m,1))) return MERRMEM;
      if (MMpush(m,MMget(m,1))) return MERRMEM;
      if (MMpush(m,2*2)) return MERRMEM;
      if (k=MBdeftab(m)) return k;
      if (MMpush(m,MMgetglobal(m,OFFSCRESS))) return MERRMEM;
      if (MMpush(m,2*2)) return MERRMEM;
      if (k=MBdeftab(m)) return k;
      MMsetglobal(m,OFFSCRESS,MMpull(m));
    }
  MMset(m,1,MMget(m,0));
  MMpull(m);
  MMechostr(MSKRUNTIME,"Fin multiress\n");
  return 0;
}


/* lecture d'un fichier */
int NSCloadfile(mmachine m,char *name)
{
	FILE *f;
	char buf[1025];
	int i,n,k,p;

	sprintf(buf,"%s/%s",execpath,name);
	f=fopen(buf,"rb");
	if (f==NULL) return MMpush(m,NIL);
	p=0;
	do
	{
		n=fread(buf,1,1024,f);
		buf[n]=0;
		if (k=Mpushstrbloc(m,buf)) return k;
		p++;
	}
	while(n==1024);
	for(i=1;i<p;i++) if (k=MBstrcat(m)) return k;
	fclose(f);
	return 0;
}

/* sauvegarde d'un fichier */
int NSCsavefile(mmachine m,char *name)
{
	FILE *f;
	int p;
	char buf[1025];

	if (!ScolSuper) return 0;
	p=MMget(m,0)>>1;
	if (p==NIL) return 0;

	sprintf(buf,"%s/%s",execpath,name);
	f=fopen(buf,"wb");
	if (f==NULL) return 0;
	fwrite(MMstartstr(m,p),1,MMsizestr(m,p),f);
	fclose(f);
	return 0;
}


/* donne a un canal tous les objets d'un autre */
int SCchangeChn(mmachine m)
{
	int newchn,oldchn;

	newchn=MMpull(m);
	oldchn=MMget(m,0);
	MMset(m,0,newchn);
	if (newchn==NIL) return 0;
	return OBJchgchannel(m,oldchn,newchn);
}

/* lecture du fichier d'initialisation des ressources */
int SCloadressini(mmachine m)
{
	return NSCloadfile(m,"usmress.ini");
}

/* sauvegarde du fichier d'initialisation des ressources */
int SCsaveressini(mmachine m)
{
	return NSCsavefile(m,"usmress.ini");
}

/* lecture du fichier usm.ini */
int SCloadusmini(mmachine m)
{
	int q,s;
	char sign[32];

	NSCloadfile(m,"usm.ini");
	q=MMpull(m);
	s=MMget(m,0);
	MMset(m,0,q);
	if ((q==NIL)||(ScolSuper)) return 0;
	
	strcpy(sign,"#");
	SCincSignInit();
	SCincSign(MMstartstr(m,q>>1),MMsizestr(m,q>>1),sign+1);
	if ((s==NIL)||(strcmp(MMstartstr(m,s>>1),sign))) MMset(m,0,NIL);
	return 0;
}


/* sauvegarde du fichier usm.ini */
int SCsaveusmini(mmachine m)
{
	int k;
	if (k=NSCsavefile(m,"usm.ini")) return k;
	SPdesallocpackdir();
	LoadUsmIni("");
	SPinitpack();
	return 0;
}

/* transfer d'un fichier */
int SCcopyFile(mmachine m)
{
	int p,q,n;
	FILE *r,*w;
	char buf[1024];
	char *c;

	p=MMpull(m)>>1;
	q=MMpull(m)>>1;
	if ((p==NIL)||(q==NIL)||(!ScolSuper)) return MMpush(m,NIL);
	c=MMstartstr(m,p);
	if ((c[0]=='/')||(c[0]=='\\')||(c[0]=='.')||(c[0]=='/')||(c[1]==':'))
		return MMpush(m,NIL);
	r=fopen(MMstartstr(m,q),"rb");
	if (r==NULL) return MMpush(m,NIL);
	w=fopen(c,"wb");
	if (w)
	{
		do
		{
			n=fread(buf,1,1024,r);
			if (n>0) fwrite(buf,1,n,w);
		}
		while (n==1024);
		fclose(w);
	}
	else
	{
		fclose(r);
		return MMpush(m,NIL);
	}

	fclose(r);
	return MMpush(m,0);
}

/* definition du proxy */
int SCdefineproxy(mmachine m)
{
	MMpull(m);
	MMpull(m);
	MMpull(m);
	return MMpush(m,0);
}

int SCdefinesocks2(char *socks, char *mask)
{
	char *port;

	if (mask==NULL) mask="255.255.255.0";
	if ((socks==NULL)||(!stricmp(socks,"no"))) SCKsetproxy(NULL,"1080",mask);
	else
	{
		if (port=strstr(socks,":"))
		{
			*port=0;
			SCKsetproxy(socks,port+1,mask);
			*port=':';
		}
		else SCKsetproxy(socks,"1080",mask);
	}
	return 0;
}



/* definition du proxy socks*/
int SCdefinesocks(mmachine m)
{
	int msk,p;

	msk=MMpull(m)>>1;
	p=MMpull(m)>>1;
	SCdefinesocks2(p==NIL?NULL:MMstartstr(m,p),msk==NIL?NULL:MMstartstr(m,msk));
	return MMpush(m,0);
}




/************************************************/
/* $ LB : scol v 4                              */
/*                                              */
/* int SCdefinesocksVersion (mmachine m)        */
/*                                              */
/* precise the protocol version of socks        */
/************************************************/
int SCdefinesocksVersion (mmachine m)
{
int verPtr, ver;
char* verStr;

	// get string pointer
	verPtr = MMpull(m)>>1;
	if (verPtr == NIL)
		ver = 4;
	else
	{
		// get soscks version parameter
		verStr = MMstartstr (m,verPtr);
		if (!strcmp (verStr, "5"))
			ver = 5;
		else ver = 4;
	}

	// update the version value
	SOCKSsetVersion (ver);
	return MMpush (m,0);
}



/*************************************************/
/* $ LB : scol v 4                               */
/*                                               */
/* int SCdefinesocksAuthentication (mmachine m)  */
/*                                               */
/* precise if socks need authentication protocol */
/*************************************************/
int SCdefinesocksAuthentication (mmachine m)
{
int authPtr, auth;
char* authStr;

	// get string pointer
	authPtr = MMpull(m)>>1;
	if (authPtr == NIL)
		auth = 0;
	else
	{
		// get socks Authentication parameter
		authStr = MMstartstr (m, authPtr);
		if (!strnicmp (authStr, "yes", 3))
			auth = 1;
		else auth = 0;
	}

	// update the authentication value
	SOCKSsetAuthentication (auth);
	return MMpush (m,0);
}




/* proxy par defaut */
int SCdefaultproxy(mmachine m)
{
	int k;

	if (k=Mpushstrbloc(m,autoHTTPproxy)) return k;
	if (k=Mpushstrbloc(m,autoSOCKSproxy)) return k;
	if (k=Mpushstrbloc(m,"255.255.255.0")) return k;
	if (MMpush(m,3*2)) return MERRMEM;
	return MBdeftab(m);
}


/* ajout d'un chemin à la partition en cours */
int SCreduceCapacity(mmachine m)
{
  int p;

  p=MMget(m,0)>>1;
  if ((p<0)||(p>maxsock))
  {
	  MMset(m,0,NIL);
	  return 0;
  }
  maxsock=p;
  return 0;
}

/* ----------------------- */
/* gestion des executables */
/* ----------------------- */
sysexe SysExeHdList=NULL;
sysexe SysExeTlList=NULL;

/* initialise la liste des exe */
int SCexeInit()
{
	SysExeHdList=NULL;
	SysExeTlList=NULL;
	return 0;
}

/* libère la liste des exe */
int SCexeEnd()
{
	sysexe p;
	while(SysExeHdList)
	{
		p=SysExeHdList->next;
		free(SysExeHdList);
		SysExeHdList=p;
	}
	SysExeTlList=NULL;
	return 0;
}

/* recherche du path d'un exe en fonction d'une catégorie et d'un alias */
sysexe SCexeSearch(char *categ, char *name)
{
	sysexe p;
	p=SysExeHdList;
	while(p)
	{
		if ((categ==NULL || !strcmp(p->categ,categ)) && !strcmp(p->name,name)) return p;
		p=p->next;
	}
	return NULL;
}

/* ajout d'un exe dans la liste (pos=0 en tete, pos=1 en queue) */
int SCexeAdd(int pos, char *categ, char *name, char *path)
{
	sysexe p;
	if (strlen(categ)>=128) return -1;
	if (strlen(name)>=128) return -1;
	if (strlen(path)>=1024) return -1;
	if (SCexeSearch(categ,name)!=NULL) return 0;
	p=(sysexe)malloc(sizeof(struct SysExe));
	if (p==NULL) return -1;
	strcpy(p->categ,categ);
	strcpy(p->name,name);
	strcpy(p->path,path);
	if (pos==0) {
		if (SysExeTlList==NULL)
			SysExeTlList=p;
		p->prev=NULL;
		p->next=SysExeHdList;
		SysExeHdList=p;
	}
	else {
		if (SysExeHdList==NULL)
			SysExeHdList=p;
		p->prev=SysExeTlList;
		p->next=NULL;
		if (SysExeTlList==NULL)
			SysExeTlList=p;
		else {
			SysExeTlList->next=p;
			SysExeTlList=p;
		}
	}
//	MMechostr(MSKDEBUG,"pos=%d categ=<%s> name=<%s> path=<%s>\n",pos,categ,name,path);
	return 0;
}

/* suppression d'un exe dans la liste */
int SCexeDel(char *categ, char *name)
{
	sysexe p;
	if (strlen(categ)>=128) return -1;
	if (strlen(name)>=128) return -1;
	if ((p=SCexeSearch(categ,name))==NULL) return 0;
	if (p->prev)
		p->prev->next=p->next;
	else
		SysExeHdList=p->next;
	if (p->next)
		p->next->prev=p->prev;
	else
		SysExeTlList=p->prev;
	free(p);
//	MMechostr(MSKDEBUG,"categ=<%s> name=<%s>\n",categ,name);
	return 0;
}

/* lancement d'un exe : paramètres <categorie> <alias> <arguments> */
int SCstartExe(mmachine m)
{
	int p,q,r;
	sysexe e;
	char *categ,*path,*param;

	r=MMpull(m)>>1;
	q=MMpull(m)>>1;
	p=MMget(m,0)>>1;
	if ((q==NIL)||(Firstpack==Cachepack)) return 0;
	param=NULL;
	categ=NULL;
	if (r!=NIL) param=MMstartstr(m,r);
	if (p!=NIL) categ=MMstartstr(m,p);
	e=SCexeSearch(categ,MMstartstr(m,q));
	if (e) {
		path=e->path;
		if (path) StartExe(path,param);
	}
	return 0;
}

/* reconstruction de la liste des exe */
int SCrefreshExe(mmachine m)
{
	if (Firstpack==Cachepack) return MMpush(m,0);
	SCexeEnd();
	SCexeInit();
	RefreshExe();

	return MMpush(m,0);
}

/* liste des alias [S r1] d'une catégorie */
int SCgetExe(mmachine m)
{
	int p;
	char categ[128];
	sysexe e;
	int n,i,k,lg,l,s;

	p=MMpull(m)>>1;
	if (Firstpack==Cachepack) return MMpush(m,NIL);
	categ[0]=0;
	if (p!=NIL)
	{
		if (strlen(MMstartstr(m,p))>=sizeof(categ)) return MMpush(m,NIL);
		strcpy(categ,MMstartstr(m,p));
	}

	n=0;
	e=SysExeHdList;
	while(e)
	{
		if (categ==NULL || !strcmp(e->categ,categ))
		{
			lg=strlen(e->name);
			if (lg<32) lg=32;
			l=(lg+4)>>2;
			s=MMmallocCLR(m,l+1,TYPEBUF); if (s==NIL) return MERRMEM;
			strcpy(MMstartstr(m,s),e->name);
			MMsetsizestr(m,s,strlen(e->name));
			if (MMpush(m,s+s+1)) return MERRMEM;
			n++;
		}
		e=e->next;
	}

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

/* ajout d'un exe : paramètres <categorie> <fichier (type P)> */
int SCaddExe(mmachine m)
{
	int p,q;

	p=MMpull(m)>>1;
	q=MMpull(m)>>1;
	if (Firstpack==Cachepack) return MMpush(m,NIL);
	if (p==NIL || q==NIL) return MMpush(m,NIL);
	if (AddExe(MMstartstr(m,q),MMstartstr(m,p)))
		return MMpush(m,NIL);
	return MMpush(m,0);
}

/* suppression d'un exe : paramètres <categorie> <alias> */
int SCdelExe(mmachine m)
{
	int p,q;

	p=MMpull(m)>>1;
	q=MMpull(m)>>1;
	if (Firstpack==Cachepack) return MMpush(m,NIL);
	if (p==NIL || q==NIL) return MMpush(m,NIL);
	if (DelExe(MMstartstr(m,q),MMstartstr(m,p)))
		return MMpush(m,NIL);
	return MMpush(m,0);
}

/* mixage 8 bits :
en entree : [[I S] r1] I : liste [volume echantillon] + volume principal,
les volumes sont par rapport à 256 (256 : aucune amplification)
en retour : [S I] : echantillon mixé, nombre d'échantillons saturés */
int SCmix8(mmachine m)
{
	int vol,p,q,r,v,i,k,len,s;
	int *buf;
	char *src;

	vol=MMpull(m)>>1;
	if (vol<0) vol=0;

	p=MMpull(m)>>1;
	if (p==NIL) return MMpush(m,NIL);
	q=MMfetch(m,p,0)>>1;
	if (q==NIL) return MMpush(m,NIL);
	r=MMfetch(m,q,1)>>1;
	if (r==NIL) return MMpush(m,NIL);
	len=MMsizestr(m,r);
	if (len==0) return MMpush(m,NIL);
	buf=(int*)malloc(len*sizeof(int));
	if (buf==NULL) return MMpush(m,NIL);
	for(i=0;i<len;i++) buf[i]=0;
	do
	{
		q=MMfetch(m,p,0)>>1;
		if (q!=NIL)
		{
			v=MMfetch(m,q,0)>>1;
			if (v<0) v=0;
			r=MMfetch(m,q,1)>>1;
			if ((r!=NIL)&&(MMsizestr(m,r)==len))
			{
				src=MMstartstr(m,r);
				for(i=0;i<len;i++)
				{
					k=((*(src++))&255)-128;
					buf[i]+=(k*v)>>8;
				}
			}
		}
		p=MMfetch(m,p,1)>>1;
	} while(p!=NIL);
	s=MMmalloc(m,((len+4)>>2)+1,TYPEBUF); if (s==NIL) return MERRMEM;
	MMsetsizestr(m,s,len);
	src=MMstartstr(m,s);
	src[len]=0;
	p=0;
	for(i=0;i<len;i++)
	{
		k=((buf[i]*vol)>>8)+128;
		if (k>255) {k=255; p++;}
		if (k<0) {k=0; p++;}
		*(src++)=k;
	}
	free(buf);
	if (MMpush(m,s*2+1)) return MERRMEM;
	if (MMpush(m,p*2)) return MERRMEM;
	if (MMpush(m,2*2)) return MERRMEM;
	return MBdeftab(m);
}

/* mixage 16 bits :
en entree : [[I S] r1] I : liste [volume echantillon] + volume principal,
les volumes sont par rapport à 256 (256 : aucune amplification)
en retour : [S I] : echantillon mixé, nombre d'échantillons saturés */
int SCmix16(mmachine m)
{
	int vol,p,q,r,v,i,k,len,s;
	int *buf;
	short *src;

	vol=MMpull(m)>>1;
	if (vol<0) vol=0;

	p=MMpull(m)>>1;
	if (p==NIL) return MMpush(m,NIL);
	q=MMfetch(m,p,0)>>1;
	if (q==NIL) return MMpush(m,NIL);
	r=MMfetch(m,q,1)>>1;
	if (r==NIL) return MMpush(m,NIL);
	len=MMsizestr(m,r)>>1;
	if (len==0) return MMpush(m,NIL);
	buf=(int*)malloc(len*sizeof(int));
	if (buf==NULL) return MMpush(m,NIL);
	for(i=0;i<len;i++) buf[i]=0;
	do
	{
		q=MMfetch(m,p,0)>>1;
		if (q!=NIL)
		{
			v=MMfetch(m,q,0)>>1;
			if (v<0) v=0;
			r=MMfetch(m,q,1)>>1;
			if ((r!=NIL)&&(MMsizestr(m,r)==(len*2)))
			{
				src=(short*)MMstartstr(m,r);
				for(i=0;i<len;i++)
				{
#if VERSION_MAC
					k=((*((char*)src))&255)+((*(((char*)src)+1))<<8);
#else
					k=*(src++);
#endif
					buf[i]+=(k*v)>>8;
				}
			}
		}
		p=MMfetch(m,p,1)>>1;
	} while(p!=NIL);
	s=MMmalloc(m,((len*2+4)>>2)+1,TYPEBUF); if (s==NIL) return MERRMEM;
	MMsetsizestr(m,s,len*2);
	src=(short*)MMstartstr(m,s);
	src[len*2]=0;
	p=0;
	for(i=0;i<len;i++)
	{
		k=(buf[i]*vol)>>8;
		if (k>32767) {k=32767; p++;}
		if (k<-32768) {k=-32768; p++;}
		*(src++)=k;
	}
	free(buf);
	if (MMpush(m,s*2+1)) return MERRMEM;
	if (MMpush(m,p*2)) return MERRMEM;
	if (MMpush(m,2*2)) return MERRMEM;
	return MBdeftab(m);
}