vm.cpp 153 KB

Edit Raw Blame History

/* vm.cpp *****************************************************************************

   Anubis
   The virtual machine.

 **************************************************************************************/


/*

   This file contains:

   (1) Some global variables.
   (2) Tools for exceptions.
   (3) Tools for running virtual machines.
   (4) Type description tools (serialize).
   (5) All virtual machine instructions.


   Serializing/unserializing stuff is in 'serialize.cpp'.

 */


#define normal_machine
//#define show_conn_counts
#include "AnubisSupport.h"
#include "vm.h"
#include "debugger.h"
#include <time.h>
#include <stddef.h>
#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <string.h>
#include <stdio.h>
#include <assert.h>
#include <math.h>
#ifdef __cplusplus
extern "C"
{
#endif
#include <jpeglib.h>
#ifdef __cplusplus
}
#endif
#ifdef WIN32
#include <wtypes.h>
#include <float.h>
#include <process.h>
#include <io.h>
#endif
#if defined (_LINUX_) || (__BEOS__)
#include <sys/wait.h>
//#include <fenv.h>
#include <sys/time.h>
#include <dirent.h>
#include <libgen.h>
#endif
#ifdef _LINUX_
#include <fnmatch.h>
#endif
#ifdef _WITH_SSL_
#include <openssl/ssl.h>
#include <openssl/err.h>
#include <openssl/x509.h>
#endif
#include "bytecode.h"
#include "cipher.h"
#include "minver.h"
#include "DebugLog.h"
#include "dependencies.h"
#ifdef WIN32
#define LITTLE_ENDIAN
#endif
#include "AnubisProcess.h"
#include "AnubisFileLocker.h"

USING_NAMESPACE(CM);


/* Important change  since version  1.6.5: virtual machine  instructions are reached  by a
   table of functions instead of a big switch.

#ifdef WITH_STATIC_MEMBERS

Instruction  member functions (one,  two or  three for  each instruction)  are static
member  (class function)  of the  class AnubisProcess.   The table  of  functions are
themselves  static.  Since everything  is static,  the object  (the process)  must be
passed explicitly to each function.

With this method the memory size taken by the objet is small, but execution of member
functions may be a little slower.

#else

Instructions member functions are non  static (instance functions). This implies that
the tables of functions are also non static. This also implies that these tables must
be initialized by the constructor of the class.

With this method objects use more memory, but execution may be a little faster.

#endif

WITH_STATIC_MEMBERS is #defined (or not) in AnubisProcess.h.


There are 3 lists of instructions (#defined in 'bytecode.h'):

common_instructions_list
normal_instructions_list
pseudo_instructions_list

A  virtual  machine  has  3  'work  sorts',  and each  one  corresponds  to  a  set  of
instructions:

work sort              corresponding set of instructions
--------------------------------------------------------
'computing'            common + normal
'serializing'          common + pseudo
'unserializing'        common + pseudo

Hence, for example, the instruction 'ret',  which is 'common', has three functions, one
for  each  work sort,  whilst  the  instruction 'type_8',  which  is  'pseudo' has  two
functions, one for serializing and one for unserializing.

Pseudo  instructions  actually implement  descriptions  of  types.  They are  used  for
serializing and unserializing data.

Abbreviations:

MAM         Member Access Method
ci_         computing instruction
ci_decl     computing instruction declaration
ci_ftable   computing instruction functions table
si_         serializing instruction
si_decl     serializing instruction declaration
si_ftable   serializing instruction functions table
ui_         unserializing instruction
ui_decl     unserializing instruction declaration
ui_ftable   unserializing instruction functions table

Note: All this boring stuff of serialization/unserialization will disappear in Anubis 2
virtual machine, because it will be realized using the system of macros (which does not
exist in Anubis 1).

 */


//extern int strcasecmp (const char *S1, const char *S2);

/******************************************************
 *                                                    *
 *            (1) Some global variables.              *
 *                                                    *
 ******************************************************/

char *         dummy_string;
U32            anubis_empty_string;
U32            anubis_empty_byte_array; // initialized at start
U32            counting_instructions            = 0;
U32            show_syscalls                    = 0;

U32            start_end_debug                  = 0;
U32            start_debug                      = 0;
U32            end_debug                        = 0;

#define        vmbuf_size                       (2000)
char           vmbuf[vmbuf_size];

U32            jpeg_fatal_error                 = 0;

fd_set         descriptors_waited_for_input;
fd_set         the_fd_set;
fd_set         the_fd_read_set;
fd_set         the_fd_write_set;
fd_set         the_fd_except_set;

struct timeval timeout_no_wait                 = {0,0};

#define ptd_to_name_buf_size   (1025)
char           ptd_to_name_buf[ptd_to_name_buf_size];

AnubisAllocator *the_default_ssl_allocator      = NULL;
AnubisAllocator *current_ssl_allocator          = NULL;

#ifdef record_allocations
U32            passed                           = 0;
U32*           passed_seg;
U32            passed_cnt_old                   = 0;
U32            passed_seg_IP                    = 0;
#endif
#ifdef debug_vm
U32            IPcode                           = 0;
#endif


extern         String                anubis_directory;
extern         String                my_anubis_directory;
extern         String                trusted_certs_directory;
extern         U32                   must_restart_flag;


/*MHMH*/
// I also added memset instructions.
// Use memcmp instruction for some comparison instead of loops
//#define use_memcmp
// Use memmove instruction instead of a while loop for colapsing the stack.
//#define use_memmove
/*MHMH*/
// Personnal memset16 & memset32 functions
void memset16(void *dest, uint16_t value, uintptr_t size)
{
  // Check that the size is a multiple of two bytes, i.e. last bit is 0
  assert((size&1)==0);
  uintptr_t i = 0;
  for( ; i < (size & (~1)); i+=2 ) { memcpy(((uint8_t*)dest) + i, &value, 2 ); }
}

void memset32(void *dest, uint32_t value, uintptr_t size)
{
  // Check that the size is a multiple of 4 bytes, i.e. last 2 bit are 0
  assert((size&3)==0);
  uintptr_t i = 0;
  for( ; i < (size & (~3)); i+=4 ) { memcpy(((uint8_t*)dest) + i, &value, 4 ); }
}


/*************************************************
 *                                               *
 *      (2) Tools for exceptions.                *
 *                                               *
 *************************************************/


void jpeg_anb_error_exit(j_common_ptr cinfo)
{
  jpeg_fatal_error = 1;
  //printf("Fatal error in libjpeg.\n"); exit(1);
}

void jpeg_anb_emit_message(j_common_ptr cinfo, int msg_level)
{
}

#if defined (_LINUX_) || (__BEOS__)
//#define FE_STRONG_EXCEPT  (FE_ALL_EXCEPT)
#define FE_STRONG_EXCEPT  (FE_DIVBYZERO|FE_OVERFLOW|FE_INVALID)
#endif
void handle_sigfpe(int sig)
{
  Debugger::DumpProcesses();
  my_exit(1);
}

#if defined (_LINUX_) || (__BEOS__)
#define feclearexcept(n)
#define fetestexcept(n,x)  (isnan(x) || (isinf(x)))
#endif
//#define fetestexcept(n,x)  (isnan(x))
#define FE_DIVBYZERO 0
#define FE_OVERFLOW 0
#define FE_INVALID 0
#ifdef WIN32
#define FE_STRONG_EXCEPT  (0)
U32 fp_error = 0;

void feclearexcept(U32 n)
{
#ifndef  __STRICT_ANSI__
  //_fpreset();
#endif
  fp_error = 0;
}

U32 fetestexcept(U32 n, double x)
{
  return fp_error;
}

void fphandler(U32 sig, U32 err)
{
  fp_error = 1;
}

PROCESS_INFORMATION* procInfo = NULL;

#endif
char float_buffer[200];

#ifdef WATCH_CODE
void compare_watched_code(U32 ip)
{
  U32 i;
  for(i = 0; i < watched_code_size; i++)
    if (original_code[i] != duplicate_code[i])
    {
      printf("**--**--> Code modified at offset %lu while IP = %d (%s)\n",i,ip,instr_names[original_code[ip]]);
      duplicate_code[i] = original_code[i];
    }
}
#endif


/*****************************************************************
 *                                                               *
 *        (3) Tools for running virtual machines.                *
 *                                                               *
 *****************************************************************/

#define check_stack(n) do { if (MAM(m_SP)+(n) >= MAM(m_SP_end)) {\
  MAM(m_status) = need_bigger_stack; goto end; }} while(0)

/*--------------------------------------------------------------*/
const char *instr_names[] = {
#define item(n)   #n,
  common_instructions_list
#undef item
#define item(n)   #n,
  normal_instructions_list
#undef item
#define item(n)   #n,
  pseudo_instructions_list
#undef item
    "dummy" };

#ifdef debug_vm
U32 debugging = 0;
U32 step = 0;

#define sc_item(n,a,f)     #n,
const char *syscall_names[] = {
  syscall_list
    "dummy" };
#undef sc_item
#define sc32_item(n,f)   #n,
const char *syscall32_names[] = {
  syscall32_list
    "dummy" };
#undef sc32_item
/* getting the name of an instruction */
const char *instr_name(U32 i, U32 n)
{
  if (i == i_syscall)
    return syscall_names[n];
  else if (i == i_syscall32)
    return syscall32_names[n];
  else
    return instr_names[i];
}

#endif


#ifdef debug_vm
#define do_case(i)   case i: if (debugging ||\
    (start_end_debug && (start_debug<=(U32)(MAM(m_IP)-MAM(m_code_begin))) && ((U32)(MAM(m_IP)-MAM(m_code_begin))<=end_debug))) {\
  LOGINFO("\n\nstack: ");\
  { U32 *p; for (p = MAM(m_SP)-1; p >= MAM(m_SP_begin) && p >= MAM(m_SP)-6; p--) \
    LOGINFO("%.8x ",*p); }\
  LOGINFO("\n%d %s IP=%d SP=%.3d R=%.8x I=%.3d uf=%d sbuf=%d snxt=%d ssiz=%d mem=%d\n",\
      MAM(m_pid), ShortString((CM::AnubisProcess::WorkSort)MAM(m_work_sort)),\
      MAM(m_IP)-MAM(m_code_begin),MAM(m_SP)-MAM(m_SP_begin),MAM(m_R),MAM(m_I),(U32)(MAM(m_unserial_failed)),\
      (U32)(MAM(m_serial_buf)),MAM(m_serial_next),MAM(m_serial_size),memory_in_use);\
  LOGINFO(">>>>>>   %16s [%.3d] %.3d %.3d %.3d %.3d %.3d %.3d %.3d %.3d %.3d %.3d %.3d %.3d",\
      instr_name(i,get16(1)),i,\
      get8(1),get8(2),get8(3),get8(4),get8(5),get8(6),get8(7),get8(8),get8(9),get8(10),get8(11),get8(12));\
  fflush(stdout); }
#else
#ifdef instruction_count
#define do_case(i)   case i: ((MAM(m_i_count))[i])++;
#else
/*---------------------------------------------------------------*/
#define do_case(i)   case i:
#endif
#endif

#define get8(d)           ((*(((U8 *)(MAM(m_IP)+(d))))))
#define get16(d)          ((*(((U16 *)(MAM(m_IP)+(d))))))
#define get32(d)          ((*(((U32 *)(MAM(m_IP)+(d))))))
#define getsigned32(d)    ((*(((int32_t *)(MAM(m_IP)+(d))))))
#define serial_words_increment     (1024)


/*******************************************************
 *                                                     *
 *    (4) Type description tools (serialize).          *
 *                                                     *
 *******************************************************/


/* Checking that a word represents a valid datum of a given small type. */
/* type description as constructed in 'implem.c' */


/* (copy-pasted from 'implem.c')

   small types descriptions: They are lists on integers defined by the following grammar:

   <na> :=   8 bits integer (number of alternatives)
   <iw> :=   8 bits integer (index width)
   <nc> :=   8 bits integer (number of components)

   <small type descr> :=    <iw> <na> <alt descr> ...   (as many <alt descr> as <na>)

   <alt descr> := <nc> <small type descr> ...   (as many as <nc>)

   The next function computes the description for a small type.
 */

#if 0
static void print_alt_des_aux(U8 **type_des_a,   /* 'type_des_a' stands for 'type description address' */
    U32 indent);

static void print_type_des_aux(U8 **type_des_a,
    U32 indent)
{
  U32 i, iw, na;
  iw = (*type_des_a)[0];
  na = (*type_des_a)[1];
  for(i = 0; i < indent; i++)
    LOGINFO(" ");

  LOGINFO("iw=%d na=%d\n",iw,na);
  (*type_des_a) += 2;
  for(i = 0; i < na; i++)
    print_alt_des_aux(type_des_a,indent+4);
}

static void print_alt_des_aux(U8 **type_des_a,
    U32 indent)
{
  U32 i, nc;
  nc = (*type_des_a)[0];
  for(i = 0; i < indent; i++)
    LOGINFO(" ");

  LOGINFO("nc=%d\n",nc);
  (*type_des_a) += 1;
  for(i = 0; i < nc; i++)
    print_type_des_aux(type_des_a,indent+4);
}

static void print_type_des(U8 **type_des_a)
{
  U8 *tda;
  tda = *type_des_a;
  print_type_des_aux(&tda,0);
}
#endif

static void skip_type_des(U8 **type_des_a,    /* pointer to somewhere within type description */
    U32 nc);            /* number of components */


/* skip as many alternative descriptions as 'nalt' */
static void skip_alt_des(U8 **type_des_a, U32 nalt)
{
begin:
  if (nalt == 0)
    return;          /* nothing to skip */
  else
  {
    U32 nc = (U32)((*type_des_a)[0]);      /* number of components */
    (*type_des_a)++;                       /* point to first component */
    skip_type_des(type_des_a,nc);          /* skip all components */
    nalt--;                                /* do for next alternative */
    goto begin;
  }
}


/* skip as many type descriptions as 'nc' */
static void skip_type_des(U8 **type_des_a,
    U32 nc)             /* number of type descriptions to skip */
{
begin:
  if (nc == 0)
  {
    return;        /* nothing to skip */
  }
  else
  {
    U32 nalt;
    /* skip one type description */
    (*type_des_a)++;                   /* ignore index width */
    nalt = (U32)((*type_des_a)[0]);    /* get number of alternatives */
    (*type_des_a)++;                   /* and skip it */
    skip_alt_des(type_des_a,nalt);     /* skip all alternatives */
    nc--;                              /* do for next type description */
    goto begin;
  }
}

U32 check_small_alt_datum(U32 datum, U32 *start_bit_a, U8 **alt_des_a);


/* check a small datum, starting from some bit, using some type description */
U32 check_small_datum(U32 datum,          /* datum to be checked */
    U32 *start_bit_a,   /* where the datum starts */
    U8 **type_des_a)    /* type description for this datum */
  /* return 1 on success, 0 on error */
{
  /* the  first byte of  description is the  index width. The next  one is the  number of
     alternatives.  The other  bytes describe the alternatives. We  must check that the
     index in the datum is between 0 and the number of alternatives (not included).
   */

  U32 iw = (U32)((*type_des_a)[0]);                         /* index width */
  U32 index = ((datum)>>(*start_bit_a))  & ((1<<iw)-1);     /* actual index */
  U32 nalt = (U32)((*type_des_a)[1]);                       /* number of alternatives */

  /*
     printf("*type_des_a = %p\n",*type_des_a);

     print_type_des(type_des_a);

     printf("check_small_datum: datum = %d, *start_bit_a = %d, iw = %d, index = %d, nalt = %d\n",
     datum,*start_bit_a,iw,index,nalt); fflush(stdout);
   */

  (*type_des_a) += 2;                        /* skip <iw> and <na> */

  if (index >= nalt)
  {
    //printf("index (=%d) >= nalt (=%d) index width: %d\n",index,nalt,iw); fflush(stdout);
    return 0;  /* unserialization error */
  }
  else
  {
    /* The index is correct. We must find the description of the corresponding alternative,
       and check the components. */
    skip_alt_des(type_des_a,index);
    *start_bit_a += iw;
    //printf("*start_bit_a += %d\n",iw);
    if (!check_small_alt_datum(datum,start_bit_a,type_des_a)) return 0;
    skip_alt_des(type_des_a,nalt-index-1); /* skip remaining alternatives */
    return 1;
  }
}

U32 check_small_alt_datum(U32 datum, U32 *start_bit_a, U8 **alt_des_a)
{
  U32 i;
  U32 nc = (U32)((*alt_des_a)[0]);   /* number of components */

  /*
     printf("*alt_des_a = %p\n",*alt_des_a);

     printf("check_small_alt_datum: datum = %d, *start_bit_a = %d, nc = %d\n",
     datum,*start_bit_a,nc); fflush(stdout);
   */

  (*alt_des_a)++;                    /* points to components type descriptions */
  for (i = 0; i < nc; i++)
  {
    if (!check_small_datum(datum,start_bit_a,alt_des_a))
      return 0; /* error */
  }
  return 1;
}


/**************************************************
 *                                                *
 *    (5) All virtual machine instructions.       *
 *                                                *
 **************************************************/


/* All instructions  of the virtual machine  as member functions of  AnubisProcess ('mi' =
   'member instruction'). */


/* The 'invalid' instruction should never be  executed.  If the machine is led to execute
   this instruction, this means that the code is probably corrupted. The action is
   to stop the  virtual machine, with an 'invalid_instruction'  status. The scheduler will
   log the event and destroy the machine. */
ci_decl(invalid)
{
  trace
    MAM(m_status) = invalid_instruction;
}


/* The instruction 'protect'  is encountered when the virtual machine  enters a section of
   'protected' code, i.e.  a piece of  code which should not be executed simultaneously by
   several virtual machines.

   The size  of this  instruction is  2.  The first  byte is  the instruction  itself. The
   second  byte is 0  when the  protected code  is not  currently executed,  1 when  it is
   currently executed by some machine. */
ci_decl(protect)
{
  trace
    if (get8(1))  /* if code already in execution by some machine */
    {
      MAM(m_steps) = 0; /* wait... (give up) */
      common_sleep(1);
      return;
    }
    else
    {
      MAM(m_IP)[1] = 1;  /* protect it */
      MAM(m_IP) += 1+1;  /* next instruction */
    }
}


/* Normally,  we  reach the  instruction  'unprotect'  only if  we  are  the sole  machine
   currently  executing the  previous  piece of  code.  The size  of  this instruction  is
   1+4. The operand is the address of the corresponding 'protect' instruction. */
ci_decl(unprotect)
{
  trace
    *((U8 *)(get32(1)+1)) = 0; /* unprotect the piece of code */
  MAM(m_steps) = 0; /* wait... (give up) */
  MAM(m_IP) += 1+4;
}


/* Format:              i_lock
Size:                1

'lock' has  a file name in MAM(m_R).   We must verify if  the file is not  already locked by
another machine.  If it  is, we wait. Otherwise, we lock it (i.e.   put his name in the
locked_file field of the machine). */
ci_decl(lock)
{
  trace
    char *filename = ((char *)MAM(m_R))+4;

  if (!(TheAnubisFileLocker->Lock(filename, MAM(GetPid()))))
  {
    MAM(m_steps) = 0;  /* wait */
    return;
  }
  /* we delete virtually the filename, because the locker makes a copy of it. */
  if (MAM(m_R) &&
      *((U32 *)MAM(m_R)) &&
      !(--(*((U32 *)MAM(m_R)))))
  {
    MAM(m_allocator)->FreeDataSegment((U32 *)MAM(m_R));
  }
  MAM(m_IP) += 1;
}


/* Format:              i_unlock
Size:                1

'unlock' the file and delete the file name. The content of MAM(m_R) must be unchanged.  */
ci_decl(unlock)
{
  trace
    TheAnubisFileLocker->Unlock(MAM(GetPid()));
  MAM(m_IP) += 1;
}


/* 'give_up' is executed when entering a 'wait  for' loop. The delay in milliseconds is on
   the stack  (it is an Word32).  The scheduler will  not restart this machine  before the
   delay is elapsed (see anbexec.cpp). */
ci_decl(give_up)
{
  trace
    U32 delay = (U32)(*(MAM(m_SP)-1));
  struct timeval curtime;
  gettimeofday(&curtime,NULL);
  /* compute the time at which we should wake up */
  if (delay > 0)
  {
    (MAM(m_alarm)).tv_sec = (curtime.tv_sec) + (delay/1000);
    (MAM(m_alarm)).tv_usec = (curtime.tv_usec) + (1000*(delay%1000));
    if ((MAM(m_alarm)).tv_usec > 1000000)
    { /* compute the carry */
      ((MAM(m_alarm)).tv_sec)++;
      ((MAM(m_alarm)).tv_usec) -= 1000000;
    }
    /* change machine status */
    MAM(m_status) = waiting_for_condition;
  }
  MAM(m_IP) += 1;
  MAM(m_steps) = 0; /* and wait ... */
}


ci_decl(start_debug_avm)
{
  trace
#ifdef debug_vm
    debugging = 1;
#endif
  //printf("start debug: ((U32 *)(*(MAM(m_SP)-1)))[0] = %d\n",((U32 *)(*(MAM(m_SP)-1)))[0]); fflush(stdout);
  MAM(m_IP) += 1;
}


ci_decl(stop_debug_avm)
{
  trace
#ifdef debug_vm
    debugging = 0;
#endif
  //printf("stop debug: ((U32 *)(*(MAM(m_SP)-1)))[0] = %d\n",((U32 *)(*(MAM(m_SP)-1)))[0]); fflush(stdout);
  MAM(m_IP) += 1;
}


/* Format     check_stack (U32)n
Size:      1+4

This  instruction checks  if it  is possible  to push  n words  into the  stack without
overflowing it.  If it is  the case, the  next instruction is executed.  Otherwise, the
virtual machine gives  up with a 'need_bigger_stack' status.   It is the responsability
of the scheduler to provide a bigger stack to this machine and to restart it.

The  compiler generates  'check_stack' instructions  cleverly enough  so that  no stack
checking  is  necessary  in  any  other instruction.   'check_stack'  instructions  are
'cleverly'  optimized  by  the compiler,  so  that  each  function  has only  one  such
instruction at its beginning. */
ci_decl(check_stack)
{
  trace
    if (MAM(m_SP)+get32(1)+10 >= MAM(m_SP_end))
    {
      MAM(m_status) = need_bigger_stack;
      MAM(m_steps) = 0;
      return;
    }
  MAM(m_steps)--;
  MAM(m_IP) += 1+4;
}


/* Format:     i_push
Size:       1

This instruction  pushes the  word in  MAM(m_R) into the  stack. After  this action,  MAM(m_R) is
considered empty, hence no virtual copy is performed. */
ci_decl(push)
{
  trace
    *(MAM(m_SP)++) = MAM(m_R);      /* push MAM(m_R) on top of stack */
  MAM(m_IP) += 1;
}


/* Format:     i_pop1   i_pop3
Size:       1

This instruction removes one or three 'dead' words from the top of stack. A 'dead' word
is  a word  which does  not contain  any reference  counted anywhere.  Hence it  may be
removed without worring about garbage collection. */
ci_decl(pop1)
{
  trace
    MAM(m_SP) -= 1;
  MAM(m_IP) += 1;
}
ci_decl(pop3)
{
  trace
    MAM(m_SP) -= 3;
  MAM(m_IP) += 1;
}


/* Format:     peek (U32)depth
Size:       1+4

This instruction 'peeks' the manipulation word  at depth 'depth' in the stack, and puts
it into MAM(m_R). This  is a duplication, and the original is  unchanged. No virtual copy is
performed.  If a virtual copy is  needed, the compiler generates a 'copy', 'copy_mixed'
or 'copy_ptr' or similar instruction just after this one. */
ci_decl(peek)
{
  trace
    MAM(m_R) = *(MAM(m_SP)-get32(1)-1);
  MAM(m_steps)++;   /* make sure not to be interrupted before next 'copy' instruction is executed */
  MAM(m_IP) += 1+4;
}


/* 'peek_push' is an optimisation (equivalent to 'peek' followed by 'push'; see compiler/src/optimize.c) */
ci_decl(peek_push)
{
  trace
    MAM(m_R) = *(MAM(m_SP)-get32(1)-1);
  *(MAM(m_SP)++) = MAM(m_R);      /* push MAM(m_R) on top of stack */
  MAM(m_steps)++;
  MAM(m_IP) += 1+4;
}


/* Format:     peek_copy_push_ptr (U32)depth
Size:       1+4

'peek_copy_push_ptr d' is equivalent to the sequence:

peek d
copy_ptr
push

Of course the intermediate results are not copied to R.
 */
ci_decl(peek_copy_push_ptr)
{
  U32 x;
  trace
    /* peek d */
    x = *(MAM(m_SP)-get32(1)-1);
  /* copy_ptr */
  if (*((U32 *)(x)) != 0) (*((U32 *)(x)))++;
  /* push */
  *(MAM(m_SP)++) = x;
  MAM(m_R) = x;
  MAM(m_IP) += 1+4;
}

/* The same one without the push */
ci_decl(peek_copy_ptr)
{
  U32 x;
  trace
    /* peek d */
    x = *(MAM(m_SP)-get32(1)-1);
  /* copy_ptr */
  if (*((U32 *)(x)) != 0) (*((U32 *)(x)))++;
  MAM(m_R) = x;
  MAM(m_IP) += 1+4;
}


/* Format:     peek_copy_push_function (U32)depth
Size:       1+4

'peek_copy_push_function d' is equivalent to the sequence:

peek d
copy_function
push

Of course the intermediate results are not copied to R.
 */
ci_decl(peek_copy_push_function)
{
  U32 x;
  trace
    /* peek d */
    x = *(MAM(m_SP)-get32(1)-1);
  /* copy_function */
  if (x&1)
  { /* top level function */
    vcopy_module_ref((U8 *)x,relative_IP(MAM(m_IP)));
  }
  else
  { /* closure function */
    if (*((U32 *)(x)) != 0)
      (*((U32 *)(x)))++;
  }
  /* push */
  *(MAM(m_SP)++) = x;
  MAM(m_R) = x;
  MAM(m_IP) += 1+4;
}


/* The same one without the push */
ci_decl(peek_copy_function)
{
  U32 x;
  trace
    /* peek d */
    x = *(MAM(m_SP)-get32(1)-1);
  /* copy_function */
  if (x&1)
  { /* top level function */
    vcopy_module_ref((U8 *)x,relative_IP(MAM(m_IP)));
  }
  else
  { /* closure function */
    if (*((U32 *)(x)) != 0)
      (*((U32 *)(x)))++;
  }
  MAM(m_R) = x;
  MAM(m_IP) += 1+4;
}


/* Format:     peek_copy_push_int (U32)depth
Size:       1+4

'peek_copy_push_int d' is equivalent to the sequence:

peek d
copy_int
push

Of course the intermediate results are not copied to R.
 */
ci_decl(peek_copy_push_int)
{
  U32 x;
  trace
    /* peek d */
    x = *(MAM(m_SP)-get32(1)-1);
  /* copy_int */
  if (!(x&1)) if (*((U32 *)(x&pointer_mask)) != 0) (*((U32 *)(x&pointer_mask)))++;
  /* push */
  *(MAM(m_SP)++) = x;
  MAM(m_R) = x;
  MAM(m_IP) += 1+4;
}


/* The same one without the push */
ci_decl(peek_copy_int)
{
  U32 x;
  trace
    /* peek d */
    x = *(MAM(m_SP)-get32(1)-1);
  /* copy_int */
  if (!(x&1)) if (*((U32 *)(x&pointer_mask)) != 0) (*((U32 *)(x&pointer_mask)))++;
  MAM(m_R) = x;
  MAM(m_IP) += 1+4;
}


/* Format:     peek_copy_push_mixed (U8)mask (U32)depth
Size:       1+1+4

'peek_copy_push_mixed m d' is equivalent to the sequence:

peek d
copy_mixed m
push

Of course the intermediate results are not copied to R.
 */
ci_decl(peek_copy_push_mixed)
{
  U32 x, *ptr;
  trace
    /* peek d */
    x = *(MAM(m_SP)-get32(2)-1);
  /* copy_mixed m */
  if ((1<<((x)&3)) & get8(1))  /* check if alternative mixed */
  {
    ptr = (U32 *)((x)&pointer_mask);
    if (*ptr) (*ptr)++;  /* increment only if non permanent */
  }
  /* push */
  *(MAM(m_SP)++) = x;
  MAM(m_R) = x;
  MAM(m_IP) += 1+1+4;
}

/* The same one without the push */
ci_decl(peek_copy_mixed)
{
  U32 x, *ptr;
  trace
    /* peek d */
    x = *(MAM(m_SP)-get32(2)-1);
  /* copy_mixed m */
  if ((1<<((x)&3)) & get8(1))  /* check if alternative mixed */
  {
    ptr = (U32 *)((x)&pointer_mask);
    if (*ptr) (*ptr)++;  /* increment only if non permanent */
  }
  MAM(m_R) = x;
  MAM(m_IP) += 1+1+4;
}


/* Format:        micro_peek (U32)<mctxt depth> (U32)<position>
Size:          1+4+4

This instruction peeks the datum at position 3+<position> in the micro context at depth
<depth> in the stack, and puts it into MAM(m_R). Virtual copy will be performed if needed by
next instruction. */
ci_decl(micro_peek)
{
  trace
    MAM(m_R) = ((U32 *)(*(MAM(m_SP)-get32(1)-1)))[3+get32(5)];
  MAM(m_steps)++;   /* make sure not to be interrupted before next 'copy' instruction is executed */
  MAM(m_IP) += 1+4+4;
}

/* the same one pushing the result onto the stack */
ci_decl(micro_peek_push)
{
  trace
    MAM(m_R) = ((U32 *)(*(MAM(m_SP)-get32(1)-1)))[3+get32(5)];
  *(MAM(m_SP)++) = MAM(m_R);      /* push MAM(m_R) on top of stack */
  MAM(m_steps)++;   /* make sure not to be interrupted before next 'copy' instruction is executed */
  MAM(m_IP) += 1+4+4;
}

/* Format:        micro_peek_copy_mixed (U8)mask (U32)<mctxt depth> (U32)<position>
Size:          1+1+4+4

Equivalent to the sequence 'micro_peek copy_mixed' */
ci_decl(micro_peek_copy_mixed)
{
  trace
    /* micro_peek */
    MAM(m_R) = ((U32 *)(*(MAM(m_SP)-get32(2)-1)))[3+get32(6)];
  /* copy_mixed */
  if ((1<<((MAM(m_R))&3)) & get8(1))  /* check if alternative mixed */
  {
    U32 *ptr;
    ptr = (U32 *)((MAM(m_R))&pointer_mask);
    if (*ptr) (*ptr)++;  /* increment only if non permanent */
  }
  MAM(m_IP) += 1+1+4+4;
}

/* Format:        micro_peek_copy_push_mixed (U8)mask (U32)<mctxt depth> (U32)<position>
Size:          1+1+4+4

Equivalent to the sequence 'micro_peek copy_mixed push' */
ci_decl(micro_peek_copy_push_mixed)
{
  trace
    /* micro_peek */
    MAM(m_R) = ((U32 *)(*(MAM(m_SP)-get32(2)-1)))[3+get32(6)];
  /* copy_mixed */
  if ((1<<((MAM(m_R))&3)) & get8(1))  /* check if alternative mixed */
  {
    U32 *ptr;
    ptr = (U32 *)((MAM(m_R))&pointer_mask);
    if (*ptr) (*ptr)++;  /* increment only if non permanent */
  }
  /* push */
  *(MAM(m_SP)++) = MAM(m_R);      /* push MAM(m_R) on top of stack */
  MAM(m_IP) += 1+1+4+4;
}

/* Format:        micro_peek_copy_ptr (U32)<mctxt depth> (U32)<position>
Size:          1+4+4

Equivalent to the sequence 'micro_peek copy_ptr' */
ci_decl(micro_peek_copy_ptr)
{
  trace
    /* micro_peek */
    MAM(m_R) = ((U32 *)(*(MAM(m_SP)-get32(1)-1)))[3+get32(5)];
  /* copy_ptr */
  if (*((U32 *)(MAM(m_R))) != 0)
    (*((U32 *)(MAM(m_R))))++;
  MAM(m_IP) += 1+4+4;
}

/* Format:        micro_peek_copy_push_ptr (U32)<mctxt depth> (U32)<position>
Size:          1+4+4

Equivalent to the sequence 'micro_peek copy_ptr push' */
ci_decl(micro_peek_copy_push_ptr)
{
  trace
    /* micro_peek */
    MAM(m_R) = ((U32 *)(*(MAM(m_SP)-get32(1)-1)))[3+get32(5)];
  /* copy_ptr */
  if (*((U32 *)(MAM(m_R))) != 0)
    (*((U32 *)(MAM(m_R))))++;
  /* push */
  *(MAM(m_SP)++) = MAM(m_R);      /* push MAM(m_R) on top of stack */
  MAM(m_IP) += 1+4+4;
}

/* Format:        micro_peek_copy_function (U32)<mctxt depth> (U32)<position>
Size:          1+4+4

Equivalent to the sequence 'micro_peek copy_function' */
ci_decl(micro_peek_copy_function)
{
  trace
    /* micro_peek */
    MAM(m_R) = ((U32 *)(*(MAM(m_SP)-get32(1)-1)))[3+get32(5)];
  /* copy_function */
  if (MAM(m_R)&1)
  { /* top level function */
    vcopy_module_ref((U8 *)(MAM(m_R)),relative_IP(MAM(m_IP)));
  }
  else
  { /* closure function */
    if (*((U32 *)(MAM(m_R))) != 0)
      (*((U32 *)(MAM(m_R))))++;
  }
  MAM(m_IP) += 1+4+4;
}

/* Format:        micro_peek_copy_push_function (U32)<mctxt depth> (U32)<position>
Size:          1+4+4

Equivalent to the sequence 'micro_peek copy_function push' */
ci_decl(micro_peek_copy_push_function)
{
  trace
    /* micro_peek */
    MAM(m_R) = ((U32 *)(*(MAM(m_SP)-get32(1)-1)))[3+get32(5)];
  /* copy_function */
  if (MAM(m_R)&1)
  { /* top level function */
    vcopy_module_ref((U8 *)(MAM(m_R)),relative_IP(MAM(m_IP)));
  }
  else
  { /* closure function */
    if (*((U32 *)(MAM(m_R))) != 0)
      (*((U32 *)(MAM(m_R))))++;
  }
  /* push */
  *(MAM(m_SP)++) = MAM(m_R);      /* push MAM(m_R) on top of stack */
  MAM(m_IP) += 1+4+4;
}

/* Format:        micro_peek_copy_int (U32)<mctxt depth> (U32)<position>
Size:          1+4+4

Equivalent to the sequence 'micro_peek copy_int' */
ci_decl(micro_peek_copy_int)
{
  trace
    /* micro_peek */
    MAM(m_R) = ((U32 *)(*(MAM(m_SP)-get32(1)-1)))[3+get32(5)];
  /* copy_int */
  if (!(MAM(m_R)&1))
    if (*((U32 *)(MAM(m_R)&pointer_mask)) != 0)
      (*((U32 *)(MAM(m_R)&pointer_mask)))++;
  MAM(m_IP) += 1+4+4;
}

/* Format:        micro_peek_copy_push_int (U32)<mctxt depth> (U32)<position>
Size:          1+4+4

Equivalent to the sequence 'micro_peek copy_int push' */
ci_decl(micro_peek_copy_push_int)
{
  trace
    /* micro_peek */
    MAM(m_R) = ((U32 *)(*(MAM(m_SP)-get32(1)-1)))[3+get32(5)];
  /* copy_int */
  if (!(MAM(m_R)&1))
    if (*((U32 *)(MAM(m_R)&pointer_mask)) != 0)
      (*((U32 *)(MAM(m_R)&pointer_mask)))++;
  /* push */
  *(MAM(m_SP)++) = MAM(m_R);      /* push MAM(m_R) on top of stack */
  MAM(m_IP) += 1+4+4;
}


/* Format:    collapse (U32)depth
Size:      1+4

This instruction removes  the 'dead' word which  is in the stack at  depth 'depth'. For
example, 'i_collapse 3', with the following stack:

a0 a1 a2 a3 a4 a5 ...

will change the stack to:

a0 a1 a2 a4 a5 ...

The words wich are above the removed word must be shifted down in the stack. */

ci_decl(collapse)
{
  trace
    U32 aux = get32(1);    /* get depth */
#ifdef use_memmove
  /*MHMH*/
  U32 *start = MAM(m_SP)-aux;
  if (aux) memmove( (void *)(start-1), (void *)(start), aux<<2 );
  // NOT memcpy ! The areas overlap !
  //if (aux) memcpy( (void *)(start-1), (void *)(start), aux<<2 );
#else
  while(aux)             /* shift words down beginning by the deepest */
  {
    *(MAM(m_SP)-aux-1) = *(MAM(m_SP)-aux);
    aux--;
  }
#endif
  MAM(m_SP)--;              /* adjust stack pointer */
  MAM(m_IP) += 1+4;         /* next instruction */
}


/* The same one but collapsing several words at some depth

Format:     mcollapse (U32)nwords (U32)depth
Size:       1+4+4

 */
ci_decl(mcollapse)
{
  trace;
  U32 aux = get32(5);    /* get depth */
  U32 n = get32(1);      /* number of words to collapse */
#ifdef use_memmove
  /*MHMH*/
  U32 *start = MAM(m_SP)-aux;
  if (aux) memmove( (void *)(start-n), (void *)(start), aux<<2 );
#else
  while(aux)             /* shift words down beginning by the deepest */
  {
    *(MAM(m_SP)-aux-n) = *(MAM(m_SP)-aux);
    aux--;
  }
#endif
  MAM(m_SP) -= n;           /* adjust stack pointer */
  MAM(m_IP) += 1+4+4;       /* next instruction */
}


/* Format:      glue_index (U8)i
Size:        1+1

This instruction puts its operand in MAM(m_R). The  operand is an index (i.e. the rank of an
alternative in  a type). This  is the  first operation needed  in order to  construct a
small datum. */
ci_decl(glue_index)
{
  trace
    MAM(m_R) = (U32)get8(1);
  MAM(m_IP) += 1+1;
}


/* Format:      glue (U8)width
Size:        1+1

This instruction ORs the content of MAM(m_R) with  a left shift of the word on top of stack.
The  number of bits  the word  must be  shifted is  given by  the unique  operand. This
instruction is used to glue components of small data into their manipulation word.

The word on top of stack must be removed. */
ci_decl(glue)
{
  trace
    MAM(m_R) |= ((*(--MAM(m_SP)))<<get8(1));  /* OR MAM(m_R) with removed-shifted top of stack */
  MAM(m_IP) += 1+1;
}


/* Format:      store_index (U8)index
Size:        1+1

This instruction  stores its  operand (an index  for an  alternative) into the  byte at
offset 4 in  the data segment pointed to by  MAM(m_R). This is a step  in constructing a new
datum belonging to a large alternative.

Note: ANDing with 'pointer_mask' is not required here. */
ci_decl(store_index)
{
  trace
    *(((U8 *)((MAM(m_R))&pointer_mask))+4) = get8(1);
  MAM(m_IP) += 1+1;
}


/* Format:   store_4 (U8)offset
   store_2 (U8)offset
   store_1 (U8)offset
   store_0 (U8)offset
Size:     1+1

This instruction stores  a 32 bits (store_4), 16 bits (store_2),  8 bits (store_1) word
of  0 bits  word (store_0)  at offset  'offset'  into the  data segment  pointed to  by
MAM(m_R). It is used  to put the components of the datum  when constructing a new datum
belonging either to a mixed or to a large alternative.

The component  to be stored is  poped from the top  of stack. No  garbage collection is
needed, because the datum is just moved, not duplicated.

store_0 is required  because, even if the datum  has 0 bits, it is represented  by a 32
bits word on top  of stack. This word (with no significant bit)  must be poped from the
stack.

Note: ANDing with 'pointer_mask' is required  here, because the instruction may be used
to construct  a mixed datum.   However, it is  actually not required, because  the next
instruction  'glue_mixed_index'   is  executed  always  after  the   present  one  (see
compiler). */
ci_decl(store_4)
{
  trace
    *((U32 *)(((U8 *)((MAM(m_R))&pointer_mask))+get8(1))) = *(--MAM(m_SP));
  MAM(m_IP) += 1+1;
}

ci_decl(store_2)
{
  trace
    *((U16 *)(((U8 *)((MAM(m_R))&pointer_mask))+get8(1))) = (U16)(*(--MAM(m_SP)));
  MAM(m_IP) += 1+1;
}

ci_decl(store_1)
{
  trace
    *((U8 *)(((U8 *)((MAM(m_R))&pointer_mask))+get8(1))) = (U8)(*(--MAM(m_SP)));
  MAM(m_IP) += 1+1;
}

ci_decl(store_0)
{
  trace
    --MAM(m_SP);
  MAM(m_IP) += 1+1;
}


/* Format:      glue_mixed_index (U8)index
Size:        1+1

This instruction is the last one for  constructing a mixed datum. It glues the index of
the alternative with the  pointer to the data segment. The pointer  to the data segment
is assumed to be  already in MAM(m_R). The index is ORed with  this pointer. Since the index
has exactly 2 bits, and the two  least significant bits of the pointer are always zero,
the significant bits of the pointer and the bits of the index do not overlap. */
ci_decl(glue_mixed_index)
{
  trace
    MAM(m_R) |= (U32)get8(1);
  MAM(m_IP) += 1+1;
}


/* Format:      unglue (U8)width (U8)rshift
Size:        1+1+1

This instruction 'unglues'  a sequence of contiguous bits from the  content of MAM(m_R), and
pushes it on the stack. The meaning is that a component from a small datum is pushed on
the stack, which corresponds  to the declaration of a resurgent symbol  in a case for a
small alternative.

The  operand 'rshift' is  the number  of bits  to ignore  from the  right end,  and the
operand 'width' is the number of bits to keep. In other words, the word to be pushed is
just a right shift of the content of MAM(m_R), ANDed with a mask. */
ci_decl(unglue)
{
  trace
    *(MAM(m_SP)++) = (((MAM(m_R))>>get8(2))&((1<<get8(1))-1));  /* push a masked right shift of MAM(m_R) */
  MAM(m_IP) += 1+1+1;
}


/* Format:     unstore_0 (U8)offset
   unstore_1 (U8)offset
   unstore_2 (U8)offset
   unstore_4 (U8)offset

Size:       1+1

This instruction  is similar to 'unglue',  except that it concerns  components of large
and mixed data, which do not need to be garbage-collected.

The 0 bit  (unstore_0), 8 bits (unstore_1), 16 bits (unstore_2)  or 32 bits (unstore_4)
word  at offset  'offset' in  the data  segment pointed  to by  MAM(m_R), is  pushed  on the
stack. */
ci_decl(unstore_0)
{
  trace
    *(MAM(m_SP)++) = (U32)0;
  MAM(m_IP) += 1+1;
}

ci_decl(unstore_1)
{
  trace
    *(MAM(m_SP)++) = (U32)(*(((U8 *)((MAM(m_R))&pointer_mask))+get8(1)));
  MAM(m_IP) += 1+1;
}

ci_decl(unstore_2)
{
  trace
    *(MAM(m_SP)++) = (U32)(*((U16 *)(((U8 *)((MAM(m_R))&pointer_mask))+get8(1))));
  MAM(m_IP) += 1+1;
}

ci_decl(unstore_4)
{
  trace
    *(MAM(m_SP)++) = (U32)(*((U32 *)(((U8 *)((MAM(m_R))&pointer_mask))+get8(1))));
  MAM(m_IP) += 1+1;
}


/* Format:     unstore_copy_mixed (U8)offset (U8)mask
Size:       1+1+1

This instruction is the same as 'unstore_copy' except that mixed types are concerned. A
bit  mask is  provided  which  enables to  determine  if the  alternative  is small  or
mixed. If it is small the instruction works like 'unstore_4'.  If it is mixed, it works
like 'unstore_copy'. */
ci_decl(unstore_copy_mixed)
{
  U32 *ptr;
  trace

    *MAM(m_SP) = (U32)(*((U32 *)(((U8 *)((MAM(m_R))&pointer_mask))+get8(1))));
  if ( (1<<((*MAM(m_SP))&3)) & get8(2) ) /* increment only if alt is mixed */
  {
    ptr = (U32 *)((*(MAM(m_SP)))&pointer_mask);
    if (*ptr) (*ptr)++; /* don't copy permanent data */
  }
  MAM(m_SP)++;
  MAM(m_IP) += 1+1+1;
}


/* Format:      unstore_copy_ptr (U8)offset
Size:        1+1

This  instruction pushes  on  the  stack the  pointer  to a  string  (or similar  datum
containing no reference) which is at offset  'offset' in the data segment pointed to by
MAM(m_R). The string is virtually copied (if not permanent). */
ci_decl(unstore_copy_ptr)
{
  trace
    *MAM(m_SP) = *((U32 *)(((U8 *)((MAM(m_R))&pointer_mask))+get8(1)));
  if (*((U32 *)(*MAM(m_SP))) != 0)
    (*((U32 *)(*MAM(m_SP))))++;
  MAM(m_SP)++;
  MAM(m_IP) += 1+1;
}


/* Format:      i_unstore_copy_function (U8)offset
Size:        1+1
 */
ci_decl(unstore_copy_function)
{
  trace
    /* extract the function and put it on the stack */
    *MAM(m_SP) = *((U32 *)(((U8 *)((MAM(m_R))&pointer_mask))+get8(1)));
  if ((*MAM(m_SP))&1)
  { /* top level function */
    vcopy_module_ref((U8 *)(*MAM(m_SP)),relative_IP(MAM(m_IP)));
  }
  else
  { /* closure function */
    if (*((U32 *)(*MAM(m_SP))) != 0)
      (*((U32 *)(*MAM(m_SP))))++;
  }
  MAM(m_SP)++;
  MAM(m_IP) += 1+1;
}


/* Format:      i_unstore_copy_int (U8)offset
Size:        1+1

 */
ci_decl(unstore_copy_int)
{
  trace
    /* push the Int on top of stack */
    *MAM(m_SP) = *((U32 *)(((U8 *)((MAM(m_R))&pointer_mask))+get8(1)));
  if ((*MAM(m_SP))&1)
  {
    /* no virtual copy for small Ints */
  }
  else
  {
    if (*((U32 *)((*MAM(m_SP))&pointer_mask)) != 0)   /* if non permanent big Int */
      (*((U32 *)((*MAM(m_SP))&pointer_mask)))++;
  }
  MAM(m_SP)++;
  MAM(m_IP) += 1+1;
}


/* Format:      index_direct (U8)width
Size:        1+1

This instruction extracts the  index from the small or mixed datum  contained in R. The
bit width  of the  index is given  by the unique  operand.  The  index is put  into the
register I.

Note: for a mixed datum, the compiler always puts 2 for the bit width of the index. */
ci_decl(index_direct)
{
  trace
    MAM(m_I) = (MAM(m_R))&((1<<get8(1))-1);
  MAM(m_IP) += 1+1;
}


/* Format:     index_indirect
Size:       1

This instruction extracts the index from the  data segment pointed to by MAM(m_R). This data
segment belongs to a  large alternative. The index (a byte) is at  offset 4 in the data
segment. The index is put into the register MAM(m_I). */
ci_decl(index_indirect)
{
  trace
    MAM(m_I) = ((U8 *)(MAM(m_R)))[4];
  MAM(m_IP) += 1;
}


/* Format:      select_index_direct (U8)width (U8)index (U32)addr
Size:        1+1+1+4

This instruction reads the index of bit  width 'width' in MAM(m_R), and compares it with the
given 'index'. If they are equal the next instruction is executed. Otherwise, a jump to
'addr' is performed. */
ci_decl(select_index_direct)
{
  trace
    if (((MAM(m_R))&((1<<get8(1))-1)) == get8(2))
    {
      MAM(m_IP) += 1+1+1+4;
    }
    else
    {
      MAM(m_IP) = (U8 *)get32(3);
    }
}


/* Format:      select_index_indirect (U8)index (U32)addr
Size:        1+1+4

This instruction  works like  i_select_index_direct, except that  the index is  read at
offset 4 in the data segment pointed to by MAM(m_R). */
ci_decl(select_index_indirect)
{
  trace
    if (*(((U8 *)(MAM(m_R)&pointer_mask))+4) == get8(1))
    {
      MAM(m_IP) += 1+1+4;
    }
    else
    {
      MAM(m_IP) = (U8 *)get32(2);
    }
}


/* Format:      switch (U8)n (U32)addr_1 ... (U32)addr_n
Size:        1+1+(n*4)

This  instruction implements a  jump table.  The first  (U8) operand  is the  number of
addresses in the table.  The action is to  jump to the i-th address of the table, where
i is the content of the register MAM(m_I) (previously set by some 'index' instruction).

The first operand is needed during relocation, but not used during execution. */
ci_decl(switch)
{
  trace
#if 0
    if (MAM(m_I) >= get8(1))
    {
      LOGERROR("Invalid index %d in switch at MAM(m_IP) = %d\n",MAM(m_I),relative_IP(MAM(m_IP)));
      fflush(stderr);
      my_exit(1);
    }
#endif
  MAM(m_IP) = (U8 *)get32(1+1+(4*MAM(m_I)));
}


/* Format:      jmp (U32)addr
Size:        1+4

This instruction  performs an  unconditional jump  to the address  given in  the unique
operand. It  is used  at the  end of cases  in conditionals,  to go to  the end  of the
conditional. */
ci_decl(jmp)
{
  trace
    MAM(m_IP) = (U8 *)get32(1);
}


/* Format:     address (U32)addr
Size:       1+4

The purpose  of this instruction is  to put the  address contained in its  operand into
MAM(m_R). The address is always the absolute address of a top level function .

Since version 1.13, the module containing this function has a counter which must be incremented.
 */
ci_decl(address)
{
  trace
    U32 code_addr = get32(1);
  MAM(m_R) = code_addr;

  //printf("code_addr = %ld\n",code_addr);
  vcopy_module_ref((U8 *)code_addr,relative_IP(MAM(m_IP)));
  MAM(m_IP) += 1+4;
}


/* Format:     push_function (U32)addr
Size:       1+4

This instruction pushes its operand (a top level function) on the stack.

Since version 1.13, the module containing this function has a counter which must be incremented.
 */
ci_decl(push_function)
{
  trace
    U32 code_addr = get32(1);
  assert(code_addr & 1);   /* the function is top level */
  *(MAM(m_SP)++) = code_addr;
  vcopy_module_ref((U8 *)code_addr,relative_IP(MAM(m_IP)));
  MAM(m_IP) += 1+4;
}


/* Format:     push_retpoint (U32)addr
Size:       1+4

This instruction pushes its operand on the stack. The operand is a return address. This
instruction is used before computing the values of arguments of applicative terms.  The
pushed address will be removed by a 'ret' instruction.

 */
ci_decl(push_retpoint)
{
  trace
    *(MAM(m_SP)++) = get32(1);
  MAM(m_IP) += 1+4;
}


/* Format:     execute_module

   This instruction executes a secondary module. It is called from within '+++load_adm'
   in 'predef.anubis'.

   When this instruction is on the point to be executed, the stack is as follows:

   |       ;--- stack ------------------------
   |       ;   0                            ByteArray
   |       ;   1                            Word32

   where the byte array is the code of the secondary module, and the Word32 the starting
   point within this code. The instruction 'execute_module' does the following:

   - pop the address of the byte array
   - add 8 to this address (this give the address of the actual code)
   - pop and add the starting point to this result (this gives the absolute address of the starting point)
   - put this result into IP
   - push the address of the instruction following 'execute_module'
   - push the absolute address of the starting point (which is the function called)

   The effect of this is a 'call' to the module, and this call will return to the next instruction
   with the value of the datum in the module put into R.

 */
ci_decl(execute_module)
{
  trace
    U8* next_instr = MAM(m_IP) + 1;                             /* 'execute_module' is of size 1 */
  U32 abs_start = *(MAM(m_SP)-1) + 8 + *(MAM(m_SP)-2);

  //printf("execute_module: counter of module's byte array: %lu\n",((U32 *)(*(MAM(m_SP)-1)))[0]);
  *(MAM(m_SP)++) = (U32)next_instr;                                /* push a return address */
  *(MAM(m_SP)++) = (U32)abs_start;                                 /* push the 'function' to be called */
  vcopy_module_ref((U8 *)abs_start,relative_IP(MAM(m_IP)));        /* the 'function' is a copy of the byte array */
  MAM(m_IP) = (U8 *)abs_start;                                     /* jump to module code (0 arguments) */
}


/* Format:     apply (U8)k
Size:       1+1

When this instruction is on the point to be exceuted, the stack is as follows:

a_1                 first operand of function
a_2
...
a_k                 last operand of function
f                   the function itself
r                   return address (where to come back after the call of f)

and the register R is empty (meaningless).

The reason why the function f to be called is in the stack is twofold:

(1) if this function is a closure, it contains a microcontext which is required
for executing the code generated for the body of the function. Of course,
this code is compiled in a context describing this situation.
(2) the function has to be collected after its execution. Indeed, the 'apply'
mecanism is assumed to 'eat' the function and its arguments.

Hence, since everything is ready in the stack, and since the end code of the function
will eat everything above the return address before returning, the apply instruction
has just to find the address of the code and to jump to it.

This address is f itself if f is a top level function. Otherwise it is ((U32 *)f)[1].

Old comments before version 1.13:
{
When this instruction is about to be executed, the register R contains a function. This
function may be either a top level function (if R is odd) or a closure (if R is even).

In the case of a top level function  taking (say) k arguments, the arguments are on top
of stack, above  the return address (which is the address  of the instruction following
this 'apply'. The instruction has just to perform a jump to the address in R.

In the  case of a closure,  the instruction must insert  the closure in  the stack just
below the  arguments (and just  above the  return address).  Then  it must jump  to the
address found at word offset 1 in the closure. This is because at that point the closure
is mainly considered as a extension of the context (via its micro-context) no more as
a function. It will be later garbage-colleted by 'delete_stack_function'.
}

 */
ci_decl(apply)
{
  trace
    U8 k = get8(1);              /* the format of apply is: (U8)apply (U8)k   (where k is
                                    the number of arguments)*/
  U32 f = *(MAM(m_SP)-k-1);     /* the function */

  //printf("vm: apply: jumping to address %x\n",f);
  /* jump to the right address */
  if (f&1)
  { /* top level function */
    MAM(m_IP) = (U8 *)f;
  }
  else
  { /* closure function */
    MAM(m_IP) = (U8 *)(((U32 *)f)[1]);
  }

#if 0
  How it was before version 1.13:
    if (MAM(m_R)&1)
    { /* top level function */
      MAM(m_IP) = (U8 *)(MAM(m_R));    /* jump to address in MAM(m_R) */
    }
    else
    { /* closure */
      int i;

      /* lift the arguments */
      for (i = 0; i < get8(1); i++)  /* get8(1) is k: the number of arguments */
      {
        *(MAM(m_SP)-i) = *(MAM(m_SP)-i-1);
      }
      /* adjust stack pointer */
      MAM(m_SP)++;

      /* insert the closure (no virtual copy) */
      *(MAM(m_SP)-get8(1)-1) = MAM(m_R);

      /* jump to the right address */
      MAM(m_IP) = (U8 *)(((U32 *)MAM(m_R))[1]);

      /* Note: MAM(m_R) is now empty */
    }
#endif
}


ci_decl(call)
{
  trace
    MAM(m_IP) = (U8 *)get32(1);     /* jump to address in operand */
}


/* Format:            put_copy_direct (U8)<depth> (U8)<position>
Size:              1+1+1

This instruction  peeks a datum  from the stack  at depth <depth>,  and puts it  in the
closure pointed  to from  R, at  offset 3+<position>.  No  virtual copy  needed (direct
datum). */
ci_decl(put_copy_direct)
{
  trace
    ((U32 *)MAM(m_R))[3+get8(2)] = *(MAM(m_SP)-get8(1)-1);
  MAM(m_IP) += 1+1+1;
}


/* Format:            put_micro_copy_direct (U8)<depth> (U8)<micro depth> (U8)<position>
Size:              1+1+1+1

This instruction is  similar to 'put_copy_direct' except that the datum  is to be found
at depth <micro depth> in the micro context at depth <depth> in the stack. */
ci_decl(put_micro_copy_direct)
{
  trace
    ((U32 *)MAM(m_R))[3+get8(3)] = ((U32 *)(*(MAM(m_SP)-get8(1)-1)))[3+get8(2)];
  MAM(m_IP) += 1+1+1+1;
}


/* Format:            put_copy_indirect (U8)<depth> (U8)<position>
Size:              1+1+1

This instruction is  the same as put_copy_direct except that it  must perform a virtual
copy of the  datum, i.e. increment the counter  at offset 0 in the  datum. However, the
datum must not be virtually copied if permanent (counter is zero). */
ci_decl(put_copy_indirect)
{
  trace
    U32 datum = *(MAM(m_SP)-get8(1)-1);
  ((U32 *)MAM(m_R))[3+get8(2)] = datum;
  if (((U32 *)(datum&pointer_mask))[0])
  {
    (((U32 *)(datum&pointer_mask))[0])++;
  }
  MAM(m_IP) += 1+1+1;
}


/* Format:    put_micro_copy_indirect (U8)<depth> (U8)<micro depth> (U8)<position>
Size:      1+1+1+1
 */
ci_decl(put_micro_copy_indirect)
{
  trace
    U32 datum = ((U32 *)(*(MAM(m_SP)-get8(1)-1)))[3+get8(2)];
  ((U32 *)MAM(m_R))[3+get8(3)] = datum;
  if (((U32 *)(datum&pointer_mask))[0])
    (((U32 *)(datum&pointer_mask))[0])++;
  MAM(m_IP) += 1+1+1+1;
}


/* Format:       put_copy_function (U8)<depth> (U8)<position>
Size:         1+1+1

This instructionn  is the same as i_copy_direct  except that it must  perform a virtual
copy of the  datum, i.e. increment the counter at  offset 0 in the datum,  if it is the
case that  this datum  is a closure  (i.e. is  even).  However, the  datum must  not be
copied if permanent. */
ci_decl(put_copy_function)
{
  trace
    U32 datum = *(MAM(m_SP)-get8(1)-1);
  ((U32 *)MAM(m_R))[3+get8(2)] = datum;
  if (datum&1)
  { /* top level function */
    vcopy_module_ref((U8 *)datum,relative_IP(MAM(m_IP)));
  }
  else
  { /* closure function */
    if (((U32 *)(datum))[0])
      (((U32 *)(datum))[0])++;
  }
  MAM(m_IP) += 1+1+1;
}


/* Format:       put_copy_int (U8)<depth> (U8)<position>
Size:         1+1+1

This instruction  is the same  as i_copy_direct except  that it must perform  a virtual
copy of the  datum, i.e. increment the counter at  offset 0 in the datum,  if it is the
case that this datum  is a big integer (i.e. is even).  However,  the datum must not be
copied if permanent. */
ci_decl(put_copy_int)
{
  trace
    U32 datum = *(MAM(m_SP)-get8(1)-1);
  ((U32 *)MAM(m_R))[3+get8(2)] = datum;
  if (!(datum&1))
    if (((U32 *)(datum))[0])
      (((U32 *)(datum))[0])++;
  MAM(m_IP) += 1+1+1;
}


/* Format:       put_micro_copy_function (U8)<depth> (U8)<micro depth> (U8)<position>
Size:         1+1+1+1
 */
ci_decl(put_micro_copy_function)
{
  trace
    U32 datum = ((U32 *)(*(MAM(m_SP)-get8(1)-1)))[3+get8(2)];
  ((U32 *)MAM(m_R))[3+get8(3)] = datum;
  if (datum&1)
  { /* top level function */
    vcopy_module_ref((U8 *)datum,relative_IP(MAM(m_IP)));
  }
  else
  { /* closure function */
    if (((U32 *)(datum))[0])
      (((U32 *)(datum))[0])++;
  }
  MAM(m_IP) += 1+1+1+1;
}


/* Format:       put_micro_copy_int (U8)<depth> (U8)<micro depth> (U8)<position>
Size:         1+1+1+1
 */
ci_decl(put_micro_copy_int)
{
  trace
    U32 datum = ((U32 *)(*(MAM(m_SP)-get8(1)-1)))[3+get8(2)];
  ((U32 *)MAM(m_R))[3+get8(3)] = datum;
  if (!(datum&1))
    if (((U32 *)(datum))[0])
      (((U32 *)(datum))[0])++;
  MAM(m_IP) += 1+1+1+1;
}


/* Format:            put_copy_mixed (U8)<mask> (U8)<depth> (U8)<position>
Size:              1+1+1+1

This instruction is the same as copy_direct  except that it must perform a virtual copy
of the datum,  i.e. increment the counter at offset  0 in the datum, if  it is the case
that this datum belongs to a large alternative. */
ci_decl(put_copy_mixed)
{
  trace
    U32 datum = *(MAM(m_SP)-get8(2)-1);
  U32 *ptr;
  ((U32 *)MAM(m_R))[3+get8(3)] = datum;
  if ((1<<((datum)&3)) & get8(1))
  {
    ptr = (U32 *)(datum&pointer_mask);
    if (*ptr) (*ptr)++;
  }
  MAM(m_IP) += 1+1+1+1;
}


/* Format:       put_micro_copy_mixed (U8)<mask> (U8)<depth> (U8)<micro depth> (U8)<position>
Size:         1+1+1+1+1
 */
ci_decl(put_micro_copy_mixed)
{
  trace
    U32 datum = ((U32 *)(*(MAM(m_SP)-get8(2)-1)))[3+get8(3)];
  U32 *ptr;
  ((U32 *)MAM(m_R))[3+get8(4)] = datum;
  if ((1<<((datum)&3)) & get8(1))
  {
    ptr = (U32 *)(datum&pointer_mask);
    if (*ptr) (*ptr)++;
  }
  MAM(m_IP) += 1+1+1+1+1;
}


/* Format:        put_closure_labels (U32)addr1 (U32)addr2
Size:          1+4+4

A closure is  currently under construction in MAM(m_R).  This instruction  must copy the two
addresses at byte offsets 4 and 8 in the closure.

Since version 1.13, the module containing this function has a counter which must be incremented.
 */
ci_decl(put_closure_labels)
{
  trace
    U32 code_addr = get32(1);
  ((U32 *)MAM(m_R))[1] = code_addr;
  ((U32 *)MAM(m_R))[2] = get32(5);
  vcopy_module_ref((U8 *)code_addr,relative_IP(MAM(m_IP)));
  MAM(m_IP) += 1+4+4;
}


/* Format:      ret
Size:        1

This instruction performs a jump to the address which is on top of stack, and pops this
address from the  top of stack. If the  address is the 'NULL' pointer,  the machine has
finished its  work, and must  stop with  a 'finished' status.  This is because,  when a
machine is created a NULL pointer is pushed in its stack before it is started by a jump
to its main routine. */
ci_decl(ret)
{
  trace
    MAM(m_IP) = (U8 *)(*(--MAM(m_SP)));
  if (MAM(m_IP) == NULL)   /* a return address of NULL means 'finished' */
  {
#ifdef debug_vm
    if (debugging) { printf("\n    Execution over.\n\n"); }
#endif
    //printf("*********************** Machine %d has finished.\n",(int)MAM(m_pid));
    /* The stack is freed in 'AnubisProcess.cpp' in destructor '~AnubisProcess'. */

    /*
       if (MAM(m_serial_buf) != NULL) LOGERROR("*********************** Machine %d has non NULL serialization buffer.\n",
       (int)MAM(m_pid));
     */

    MAM(m_status) = finished;
    MAM(m_steps) = 0;  /* give up */
  }
}


/* Format:      alloc (U8)n
Size:        1+1

The  'alloc' instruction  has a  unique (U8)n  operand. Its  purpose is  to  allocate a
segment of memory of n+2 32 bits words.  The pointer to the allocated segment is put in
MAM(m_R).   If  allocation  cannot  succeed,  the  virtual  machine  gives  up  with  a
'need_more_memory' status.  The  scheduler is responsible for providing  more memory to
that machine and restart it. */
ci_decl(alloc)
{
  trace
    vm_alloc1(MAM(m_R),get8(1)+2);
  MAM(m_IP) += 1+1;
}


/* Format:      free_seg_1_pop2_ret
Size:        1

The 'free_seg_1_pop2_ret'  instruction is the  counterpart of 'alloc'.  The  pointer to
the segment to be deallocated is  always *(MAM(m_SP)-2).  This is due to the particular
structure of deletion subroutines. The instruction also decrements SP by 2 and performs
a return. */
ci_decl(free_seg_1_pop2_ret)
{
  trace
    vm_free1((*(MAM(m_SP)-2))&pointer_mask);
  MAM(m_SP) -= 2;
  MAM(m_IP) = (U8 *)(*(--MAM(m_SP)));
}


/* Format:      free_closure_1_pop2_ret
Size:        1

The 'free_closure_1_pop2_ret'  instruction works like free_seg_1_pop2_ret except
that the segment to be freed is a closure. This entails that the module of this closure
must be virtually deleted.

 */
ci_decl(free_closure_1_pop2_ret)
{
  trace
    /* virtually delete the module pointed to word 1 in the closure segment */
    vdelete_module_ref((U8 *)(((U32 *)((*(MAM(m_SP)-2))&pointer_mask))[1]),
        (U32)relative_IP(MAM(m_IP)),
        MAM(m_allocator));
  /* delete the closure segment */
  vm_free1((*(MAM(m_SP)-2))&pointer_mask);
  MAM(m_SP) -= 2;
  MAM(m_IP) = (U8 *)(*(--MAM(m_SP)));
}


/* Format:      free_seg_0
Size:        1

The 'free_seg_0'  instruction is similar to  free_seg_1, except that the  segment to be
freed is at *(MAM(m_SP)-1). */
ci_decl(free_seg_0)
{
  trace
    MAM(m_allocator)->FreeDataSegment((U32 *)((*(MAM(m_SP)-1))&pointer_mask));
  MAM(m_IP) += 1;
}


/***** Dynamic Variables. *********************************************************/

/* A dynamic variable is a pointer to a segment with:

   offset   size         content
   ---------------------------------
   0        4            counter
   4        4            value
   8        4            size of handlers table
   12        4            pointer to monitor's table


   The value of the variable is changed by xchg_vv which simply exchanges the value of the
   dynamic variable on top of stack with the content of MAM(m_R).

   Each slot  in the monitor's table contains either  0 or a function  of type One  -> One
   (top_level  or  closure, which  cannot  be  0, because  top  level  functions have  odd
   addresses, and pointers to closures are  not NULL).  These functions are not counted by
   the garbage-collector  (they are fake  copies).  This is  correct because at  least one
   actual virtual copy of  the function always exists in the system  before the monitor is
   removed.

   A  new  handler  is  registred  (entered  into the  above  table)  by  the  instruction
   'i_register_monitor'. This instruction expects a dynamic variable 'v' and a handler 'h'
   (function of type One ->  One) on top of stack.  It puts the handler  in a free slot of
   the  table   (enlarging  the   table  if   needed),  and  returns   a  datum   of  type
   'MonitoringTicket' (see predefined.anubis). */


/* Format:       create_var
Size:         1

(Not to be confused with create_vars)

Creating a dynamic variable.  Allocates a segment v with four 32 bits words, and places
the top of stack at v[1].  The top  of stack is poped off, but no garbage-collection is
needed.

v[0] is the counter (already initialized at 1)
v[1] is the value of the variable (taken from the stack)
v[2] is initialized to 'default_number_of_monitors'
v[3] receives a table of v[2] U32s (monitors table).
 */
ci_decl(create_var)
{
  trace
    vm_alloc1(MAM(m_R),4);

  /* don't create a table for monitors */
  ((U32 *)MAM(m_R))[3] = (U32)NULL;
  ((U32 *)MAM(m_R))[2] = 0;

  ((U32 *)MAM(m_R))[1] = *(MAM(m_SP)-1); /* initial value */
  MAM(m_SP)--;
  MAM(m_IP) += 1;
}


/* Format:          create_mvar
Size:            1

This instruction expects the following:

at *(MAM(m_SP)-1):     Word32   n
at *(MAM(m_SP)-2):     T        init
at *(MAM(m_SP)-3):     Word32   bw

T  is  a type.   'n'  is  the  size of  the  multiple  variable  to create  (number  of
slots). 'init' is  the initial value.  'init' has been already  virtually copied in the
right number of copies for the multiple variable.  'bw' is the bit width of the data to
be  put into  the slots.  The three  words must  be removed  from the  stack  after the
creation.

The multiple variable is a pointer to a segment with:

offset       size
--------------------------------------
0            4              counter
4            4              number of slots (n)
8            4              number of places for monitors
12           4              pointer to monitors table
16           4              nbw (normalized bit width)
20           (n*nbw/8)+1    data

+1 to accomodate the rest of the division  by 8. The normalized bit width is a power of
2 less than or equal to 32. */
ci_decl(create_mvar)
{
  trace
    //          int bw = *(MAM(m_SP)-3);
    U32 nbw;
  U32 i;
  U32 n = *(MAM(m_SP)-1);
  U32 init = *(MAM(m_SP)-2);
  U32 table;

  /* compute the normalized bit width of T */
  /* currently, only bw = 32 works !
     if (bw <= 0)   nbw = 0;  else
     if (bw <= 1)   nbw = 1;  else
     if (bw <= 2)   nbw = 2;  else
     if (bw <= 4)   nbw = 4;  else
     if (bw <= 8)   nbw = 8;  else
     if (bw <= 16)  nbw = 16; else
   */
  nbw = 32;

  vm_alloc2(MAM(m_R),   byte_size_to_word_size(20+((nbw*n)>>3)+1),
      table,      default_number_of_monitors);

  /* initialize the monitor's table and size */
  ((U32 *)MAM(m_R))[2] = default_number_of_monitors;
  /* initialize the number of slots */
  ((U32 *)MAM(m_R))[1] = n;
  ((U32 *)MAM(m_R))[3] = (U32)table;

  /* put normalized bit width */
  ((U32 *)MAM(m_R))[4] = (U32)nbw;

  /* initialize monitor's table */
  /*MHMH*/
  //memset((void*)table, 0, default_number_of_monitors*sizeof(U32));
  for (i = 0; i < default_number_of_monitors; i++)
  ((U32 *)table)[i] = 0;

  /* put initial values */
  switch (nbw)
  {
    case 0:
      break;

    case 1:
      {
        /*MHMH*/
        U8 x = init == 0 ? 0 : 0xFF;
        //memset(((U8*)MAM(m_R))+20,x,(n>>3)+1);
        for (i = 0; i < (U32)(n>>3)+1; i++)
        ((U8 *)MAM(m_R))[20+i] = x;
      }
      break;

    case 2:
      {
        U8 x =
          init == 0 ? 0 :
          init == 1 ? 85 :
          init == 2 ? 170 : 255;
        /*MHMH*/
        //memset( ((U8 *)MAM(m_R))+20,x, (U32)(n>>2)+1);
        for (i = 0; i < (U32)(n>>2)+1; i++)
        ((U8 *)MAM(m_R))[20+i] = x;
      }
      break;

    case 4:
      {
        U8 x = (U8)(init|(init<<4));
        /*MHMH*/
        //memset(((U8 *)MAM(m_R))+20, x, (U32)(n>>1)+1);
        for (i = 0; i < (U32)(n>>1)+1; i++)
        ((U8 *)MAM(m_R))[20+i] = x;
      }
      break;

    case 8:
      {
        /*MHMH*/
        //memset(((U8 *)MAM(m_R))+20, init, (U32)n);
        for (i = 0; i < (U32)n; i++)
        ((U8 *)MAM(m_R))[20+i] = (U8)init;
      }
      break;

    case 16:
      {
        /*MHMH*/
        //memset16(((U16 *)MAM(m_R))+10, (U16)init, (U32)n);
        for (i = 0; i < (U32)n; i++)
          ((U16 *)MAM(m_R))[10+i] = (U16)init;
      }
      break;

    case 32:
      {
        /*MHMH*/
        //memset32(((U32 *)MAM(m_R))+5, (U32)init, (U32)n);
        for (i = 0; i < (U32)n; i++)
          ((U32 *)MAM(m_R))[5+i] = (U32)init;
      }
      break;

    default: assert(0);
  }

  /* adjust stack */
  MAM(m_SP) -= 3;
  MAM(m_IP) += 1;
}


/* Format:          push_mvar_length
Size:            1

This instruction expects a multiple variable on  top of the stack. It pushes the number
of slots of this multiple variable on the stack. */
ci_decl(push_mvar_length)
{
  trace
    U32 aux = ((U32 *)(*(MAM(m_SP)-1)))[1];
  *(MAM(m_SP)++) = aux;
  MAM(m_IP) += 1;
}


/* Format:          mvar_slots_del (U32)addr
Size:            1+4

This instruction expects:

at *(MAM(m_SP)-1):     (Word32)     the number of slots in the multiple variable
at *(MAM(m_SP)-2):     (MVar(T))    a multiple variable

where T is a large type.

It virtually deletes  the data in all the  slots of the multiple variable,  but not the
multiple variable itself.  The address 'get32(1)' is that of the deletion code for type
T.  The integer at *(SP-1) is used  as a counter for the deletion loop. The instruction
pops the counter from the stack when it becomes 0.

Since this  instruction is just a  loop calling a deletion  code, there is  no need for
worrying about  giving up.  Indeed, the  deletion code decrements 'steps'  and gives up
like any normal code. We proceed as follows:

start:                                                n mv ...
if n = 0 goto end
else virtually delete the datum and
if the counter becomes 0:
push the return address (current MAM(m_IP))            r n mv ...
push the content of slot 'n'                  c r n mv ...
jump to addr (get32(1))
else go to start
end:
pop the null counter                                  mv ...
increment MAM(m_IP)

Note: the bit width of T is 32 since T is large.
 */
ci_decl(mvar_slots_del)
{
  trace
  {
    if (MAM(m_SP)+3 >= MAM(m_SP_end))
    {
      MAM(m_status) = need_bigger_stack;
      MAM(m_steps) = 0;
      return;
    }

    if (((int32_t)(*(MAM(m_SP)-1))) <= 0)    /* counter == 0 */
    {
      MAM(m_SP)--;                     /* pop the null counter */
      MAM(m_IP) += 1+4;                /* execute next instruction */
    }
    else                          /* counter > 0 */
    {
      U32 datum;

      (*(MAM(m_SP)-1))--;              /* decrement counter before using it as an index*/
      datum = ((U32 *)(*(MAM(m_SP)-2)))[5+(*(MAM(m_SP)-1))];   /* datum to be virtually deleted */
      if (datum &&                       /* beware of 0 pseudo datum */
          ((U32 *)datum)[0] &&           /* and of permanent data */
          (!(--(((U32 *)datum)[0]))))    /* and if counter becomes 0 */
      {
        *(MAM(m_SP))   = (U32)MAM(m_IP);      /* push return address */
        *(MAM(m_SP)+1) = datum;        /* push content of slot */
        MAM(m_SP) += 2;                /* adjust stack */
        MAM(m_IP) = (U8 *)(get32(1));  /* jump to deletion code */
      }
      /* else do nothing, but just execute this instruction again */
    }
  }
}


/* Format:         mvar_slots_del_var (U32)addr
Size:           1+4

Similar to i_mvar_slots_del, but the variable contains dynamic variables. */
ci_decl(mvar_slots_del_var)
{
  trace
    if (MAM(m_SP)+3 >= MAM(m_SP_end))
    {
      MAM(m_status) = need_bigger_stack;
      MAM(m_steps) = 0;
      return;
    }

  if (((int32_t)(*(MAM(m_SP)-1))) <= 0)    /* counter == 0 */
  {
    MAM(m_SP)--;                     /* pop the null counter */
    MAM(m_IP) += 1+4;                /* execute next instruction */
  }
  else                          /* counter > 0 */
  {
    U32 datum;

    (*(MAM(m_SP)-1))--;              /* decrement counter before using it as an index*/
    datum = ((U32 *)(*(MAM(m_SP)-2)))[5+(*(MAM(m_SP)-1))];   /* datum to be virtually deleted */
    if (datum &&                       /* beware of 0 pseudo datum */
        ((U32 *)datum)[0] &&           /* and of permanent data */
        (!(--(((U32 *)datum)[0]))))    /* and if counter becomes 0 */
    {
      *(MAM(m_SP))   = (U32)MAM(m_IP);      /* push return address */
      *(MAM(m_SP)+1) = datum;        /* push content of slot */
      MAM(m_SP) += 2;                /* adjust stack */
      MAM(m_IP) = (U8 *)(get32(1));  /* jump to deletion code */
    }
    /* else do nothing, but just execute this instruction again */
  }
}


/* Format:           mvar_slots_del_mvar (U32)addr
Size:             1+4

Similar to i_mvar_slots_del, but the variable contains multiple dynamic variables. */
ci_decl(mvar_slots_del_mvar)
{
  trace
    if (MAM(m_SP)+3 >= MAM(m_SP_end))
    {
      MAM(m_status) = need_bigger_stack;
      MAM(m_steps) = 0;
      return;
    }

  if (((int32_t)(*(MAM(m_SP)-1))) <= 0)    /* counter == 0 */
  {
    MAM(m_SP)--;                     /* pop the null counter */
    MAM(m_IP) += 1+4;                /* execute next instruction */
  }
  else                          /* counter > 0 */
  {
    U32 datum;

    (*(MAM(m_SP)-1))--;              /* decrement counter before using it as an index*/
    datum = ((U32 *)(*(MAM(m_SP)-2)))[5+(*(MAM(m_SP)-1))];   /* datum to be virtually deleted */
    if (datum &&                       /* beware of 0 pseudo datum */
        ((U32 *)datum)[0] &&           /* and of permanent data */
        (!(--(((U32 *)datum)[0]))))    /* and if counter becomes 0 */
    {
      *(MAM(m_SP))   = (U32)MAM(m_IP);      /* push return address */
      *(MAM(m_SP)+1) = datum;        /* push content of slot */
      MAM(m_SP) += 2;                /* adjust stack */
      MAM(m_IP) = (U8 *)(get32(1));  /* jump to deletion code */
    }
    /* else do nothing, but just execute this instruction again */
  }
}


/* Format:         mvar_slots_del_mixed (U8)mask (U32)addr
Size:           1+1+4

This is the  same as mvar_slots_del but used when  T is a mixed type.  The bit mask for
mixed alternatives is given. */
ci_decl(mvar_slots_del_mixed)
{
  trace
    if (MAM(m_SP)+3 >= MAM(m_SP_end))
    {
      MAM(m_status) = need_bigger_stack;
      MAM(m_steps) = 0;
      return;
    }

  if (((int32_t)(*(MAM(m_SP)-1))) <= 0)    /* counter == 0 */
  {
    MAM(m_SP)--;                     /* pop the null counter */
    MAM(m_IP) += 1+1+4;              /* execute next instruction */
  }
  else                          /* counter > 0 */
  {
    U32 datum;

    (*(MAM(m_SP)-1))--;              /* decrement counter before using it as an index*/
    datum = ((U32 *)(*(MAM(m_SP)-2)))[5+(*(MAM(m_SP)-1))];   /* datum to be virtually deleted */

    if (datum &&                                    /* beware of 0 pseudo datum */
        ((1<<(datum&3))&get8(1)) &&                 /* if alternative mixed */
        ((U32 *)(datum&pointer_mask))[0] &&         /* beware of permanent data */
        (!(--(((U32 *)(datum&pointer_mask))[0]))))  /* and if counter becomes 0 */
    {
      *(MAM(m_SP))   = (U32)MAM(m_IP);      /* push return address */
      *(MAM(m_SP)+1) = datum;        /* push content of slot */
      MAM(m_SP) += 2;                /* adjust stack */
      MAM(m_IP) = (U8 *)(get32(2));  /* jump to deletion code */
    }
    /* else do nothing, but just execute this instruction again */
  }
}


/* Format:        mvar_slots_del_conn
Size:          1

Same as mvar_slots_del but for multiple variable containing connections. */
ci_decl(mvar_slots_del_conn)
{
  trace

    if (MAM(m_duc_non_empty))
    {
      if(close_connection((U8 *)MAM(m_DUC1)))
      {
        MAM(m_allocator)->FreeDataSegment((U32 *)MAM(m_DUC1));
        MAM(m_DUC1) = 0;
        MAM(m_duc_non_empty) = 0;
      }
      else
      {
        MAM(m_steps) = 0;
        return;
      }
    }
    else
    {
      if (((int32_t)(*(MAM(m_SP)-1))) <= 0)    /* counter == 0 */
      {
        MAM(m_SP)--;                     /* pop the null counter */
        MAM(m_IP) += 1;                  /* execute next instruction */
      }
      else                          /* counter > 0 */
      {
        U32 datum;

        (*(MAM(m_SP)-1))--;              /* decrement counter before using it as an index*/
        datum = ((U32 *)(*(MAM(m_SP)-2)))[5+(*(MAM(m_SP)-1))];   /* datum to be virtually deleted */
        if (datum &&                       /* beware of 0 pseudo datum */
            ((U32 *)datum)[0] &&           /* and of permanent data */
            (!(--(((U32 *)datum)[0]))))    /* and if counter becomes 0 */
        {
          if(close_connection((U8 *)datum))
            MAM(m_allocator)->FreeDataSegment((U32 *)datum);
          else
          {
            MAM(m_DUC1) = datum;
            MAM(m_duc_non_empty) = 1;
            MAM(m_steps) = 0;
          }
        }
        /* else do nothing, but just execute this instruction again */
      }
    }
}


/* Format:         mvar_slots_del_ptr
Size:           1

Same as i_mvar_slots_del but for multiple variable containing strings or the like. */
ci_decl(mvar_slots_del_ptr)
{
  trace
    if (((int32_t)(*(MAM(m_SP)-1))) <= 0)    /* counter == 0 */
    {
      MAM(m_SP)--;                     /* pop the null counter */
      MAM(m_IP) += 1;                  /* execute next instruction */
    }
    else                          /* counter > 0 */
    {
      U32 datum;

      (*(MAM(m_SP)-1))--;              /* decrement counter before using it as an index*/
      datum = ((U32 *)(*(MAM(m_SP)-2)))[5+(*(MAM(m_SP)-1))];   /* datum to be virtually deleted */
      if (datum &&                       /* beware of 0 pseudo datum */
          ((U32 *)datum)[0] &&           /* and of permanent data */
          (!(--(((U32 *)datum)[0]))))    /* and if counter becomes 0 */
      {
        MAM(m_allocator)->FreeDataSegment((U32 *)datum);
      }
      /* else do nothing, but just execute this instruction again */
    }
}


/* Format:        mvar_slots_del_function
Size:          1

Same as i_mvar_slots_del but for multiple variable containing functions. */
ci_decl(mvar_slots_del_function)
{
  trace
    if (((int32_t)(*(MAM(m_SP)-1))) <= 0)    /* counter == 0 */
    {
      MAM(m_SP)--;                     /* pop the null counter */
      MAM(m_IP) += 1;                  /* execute next instruction */
    }
    else                          /* counter > 0 */
    {
      U32 datum;

      (*(MAM(m_SP)-1))--;              /* decrement counter before using it as an index*/
      datum = ((U32 *)(*(MAM(m_SP)-2)))[5+(*(MAM(m_SP)-1))];   /* datum to be virtually deleted */
      if (datum)                       /* beware of 0 pseudo datum */
      {
        if (datum&1)
        { /* top level function */
          vdelete_module_ref((U8 *)datum,relative_IP(MAM(m_IP)),MAM(m_allocator));
        }
        else
        { /* closure function */
          if (((U32 *)datum)[0] &&           /* and of permanent data */
              (!(--(((U32 *)datum)[0]))))    /* and if counter becomes 0 */
          {
            /* call closure deletion code */
            *(MAM(m_SP)++) = (U32)(MAM(m_IP));
            *(MAM(m_SP)++) = datum;
            MAM(m_IP) = (U8 *)(((U32 *)datum)[2]);
          }
        }
      }
      /* else do nothing, but just execute this instruction again */
    }
}


/* Format:        mvar_slots_del_int
Size:          1

Same as i_mvar_slots_del but for multiple variable containing integers. */
ci_decl(mvar_slots_del_int)
{
  trace
    if (((int32_t)(*(MAM(m_SP)-1))) <= 0)    /* counter == 0 */
    {
      MAM(m_SP)--;                     /* pop the null counter */
      MAM(m_IP) += 1;                  /* execute next instruction */
    }
    else                          /* counter > 0 */
    {
      U32 datum;

      (*(MAM(m_SP)-1))--;              /* decrement counter before using it as an index*/
      datum = ((U32 *)(*(MAM(m_SP)-2)))[5+(*(MAM(m_SP)-1))];   /* datum to be virtually deleted */
      if (datum &&                       /* beware of 0 pseudo datum */
          !(datum&1) &&                  /* and if integer is big */
          ((U32 *)datum)[0] &&           /* and not permanent */
          (!(--(((U32 *)datum)[0]))))    /* and if counter becomes 0 */
      {
        /* free the segment of the big int */
        MAM(m_allocator)->FreeDataSegment((U32 *)datum);
      }
      /* else do nothing, but just execute this instruction again */
    }
}


/* Format:         mvar_slots_del_struct_ptr (U8)struct_id
Size:           1+1

Same as i_mvar_slots_del but for multiple variable containing C structures. */
ci_decl(mvar_slots_del_struct_ptr)
{
  trace
    if (((int32_t)(*(MAM(m_SP)-1))) <= 0)    /* counter == 0 */
    {
      MAM(m_SP)--;                     /* pop the null counter */
      MAM(m_IP) += 1+1;                /* execute next instruction */
    }
    else                          /* counter > 0 */
    {
      U32 datum;

      (*(MAM(m_SP)-1))--;              /* decrement counter before using it as an index*/
      datum = ((U32 *)(*(MAM(m_SP)-2)))[5+(*(MAM(m_SP)-1))];   /* datum to be virtually deleted */
      if (datum &&                       /* beware of 0 pseudo datum */
          ((U32 *)datum)[0] &&           /* and of permanent data */
          (!(--(((U32 *)datum)[0]))))    /* and if counter becomes 0 */
      {
        free_C_structure((void *)(((U32 *)datum)[1]),get8(1), MAM(m_allocator));
        MAM(m_allocator)->FreeDataSegment((U32 *)datum);
      }
      /* else do nothing, but just execute this instruction again */
    }
}


/* Format:       free_mvar_seg
Size:         1

Frees the multiple dynamic variable on top of stack. The data in the slots have already
been deleted. The instruction must adjust the stack after the multiple variable segment
has been deleted. */
ci_decl(free_mvar_seg)
{
  trace
    MAM(m_allocator)->FreeDataSegment((U32 *)(((U32 *)(*(MAM(m_SP)-1)))[3]));  /* monitor's table */
  MAM(m_allocator)->FreeDataSegment((U32 *)(*(MAM(m_SP)-1)));                /* multiple variable */
  MAM(m_SP)--;
  MAM(m_IP) += 1;
}


/* Format:    xchg_mvv (exchange multiple variable value)

Expects:   at *(MAM(m_SP)-1):    i     (index of slot)
           at *(MAM(m_SP)-2):    mv    (multiple variable)

This instruction exchanges the content of MAM(m_R) with the content of the i-th slot. */
ci_decl(xchg_mvv)
{
  trace
    U32 *  mv_seg = (U32 *)(*(MAM(m_SP)-2));
  U32     index = (*(MAM(m_SP)-1));
  U32 woffset = 0;
  //U32 rest = 0;
  U32 aux;

  if (index < mv_seg[1])  /* do nothing if out of bounds */
  {
    switch (mv_seg[4])
    {
      case 0:     woffset = 0;        /* rest = 0;         */    break;
      case 1:     woffset = index/32; /* rest = index%32;  */    break;
      case 2:     woffset = index/16; /* rest = index%16;  */    break;
      case 4:     woffset = index/8;  /* rest = index%8;   */    break;
      case 8:     woffset = index/4;  /* rest = index%4;   */    break;
      case 16:    woffset = index/2;  /* rest = index%2;   */    break;
      case 32:    woffset = index;    /* rest = 0;         */    break;
      default:    assert(0);
    }
    woffset += 5;

    /* perform the exchange */
    if (mv_seg[4] == 32)
    {
      //printf("woffset = %d, old value: %d ",woffset,mv_seg[woffset]);
      aux = MAM(m_R);
      MAM(m_R) = mv_seg[woffset];
      mv_seg[woffset] = aux;
      //printf("new value: %d ",mv_seg[woffset]);
      //printf("i_xchg_mvv: exchange done\n"); fflush(stdout);
    }
    else
    { /* other widths not yet implemented */
      assert(0); /* will never happen: 'i_create_mvar' forces nbw= 32 */
    }
  }
  MAM(m_IP) += 1;
}


/* Format:       free_var_seg
Size:         1

Frees  the dynamic  variable  segment  on top  of  the stack  and  replaces  it by  its
content. The  content will be deleted  by subsequent instructions.   The handlers table
must be freed,  but the handlers themselves need  no (the copies of them  in this table
are not counted by the garbage-collector.  Notice that another 'counted' copy exists in
the monitoring ticket). */
ci_decl(free_var_seg)
{
  U32 table = ((U32 *)(*(MAM(m_SP)-1)))[3];
  U32 x = ((U32 *)(*(MAM(m_SP)-1)))[1];    /* the content of the dynamic variable */

  trace
    if (table != (U32)NULL)
    {
      MAM(m_allocator)->FreeDataSegment((U32 *)table);  /* table */
    }
  MAM(m_allocator)->FreeDataSegment((U32 *)(*(MAM(m_SP)-1)));                /* variable */
  *(MAM(m_SP)-1) = x;
  MAM(m_IP) += 1;
}


/* Format:            get_vv
Size:              1

This instruction expects a  dynamic variable on top of the stack.  It puts the value of
the variable in MAM(m_R). No virtual copy is needed. */
ci_decl(get_vv)
{
  trace
    MAM(m_R) = ((U32 *)(*(MAM(m_SP)-1)))[1];
  MAM(m_steps)++;          /* ensure that next copy instruction will be executed now */
  MAM(m_IP) += 1;
}


/* Format:            get_mvv
Size:              1

This instruction expects the following stack:

i mv ...

where i is  an Word32, and mv a  multiple variable. The instruction must put  a copy of
the i-th slot of  the multiple variable into MAM(m_R). No virtual  copy should be done,
because it is done (if needed) by a subsequent instruction.

Recall (see 'i_create_mvar' in this file) that the segment of the variable contains:

(Word32) the number of slots at offset 1 (in 4 bytes words)
(Word32) the normalized bit width at offset 4 (in 4 bytes words)
The data at offset 5 (in 4 bytes words)
 */
ci_decl(get_mvv)
{
  trace
    U32 index = (U32)(*(MAM(m_SP)-1));
  U32 *mv_seg = (U32 *)(*(MAM(m_SP)-2));
  U32 woffset = 0;
  U32 rest = 0;

  /* keep the index within the bounds */
  index = sup(0,inf(((mv_seg[1])-1),index));

  /* compute the offset of the word to read */
  switch(mv_seg[4])
  {
    case 0:     woffset = 0;        rest = 0;        break;
    case 1:     woffset = index/32; rest = index%32; break;
    case 2:     woffset = index/16; rest = index%16; break;
    case 4:     woffset = index/8;  rest = index%8;  break;
    case 8:     woffset = index/4;  rest = index%4;  break;
    case 16:    woffset = index/2;  rest = index%2;  break;
    case 32:    woffset = index;    rest = 0;        break;
    default: assert(0);
  }
  woffset += 5;

  /* copy the word to MAM(m_R) */
  MAM(m_R) = mv_seg[woffset];

  /* mask unwanted bits */
  switch(mv_seg[4])
  {
    case 0:     MAM(m_R) = 0;                 break;
    case 1:     MAM(m_R) = (MAM(m_R)>>rest)&1;       break;
    case 2:     MAM(m_R) = (MAM(m_R)>>rest)&3;       break;
    case 4:     MAM(m_R) = (MAM(m_R)>>rest)&15;      break;
    case 8:     MAM(m_R) = (MAM(m_R)>>rest)&255;     break;
    case 16:    MAM(m_R) = (MAM(m_R)>>rest)&65535;   break;
    case 32:                           break;
    default: assert(0);
  }
  MAM(m_IP) += 1;
}


/* Format:           xchg_vv
Size:             1

This instruction exchanges the content of  MAM(m_R) with the content of the dynamic variable
on top of stack. */
ci_decl(xchg_vv)
{
  trace
    U32 x = ((U32 *)(*(MAM(m_SP)-1)))[1];     // get old value of variable
  ((U32 *)(*(MAM(m_SP)-1)))[1] = MAM(m_R);       // put new value
  MAM(m_R) = x;                             // put old value in MAM(m_R) (will be deleted by next instruction)
  MAM(m_IP) += 1;
}


/* remove_monitor

   Expects  a monitoring  ticket  on top  of stack.   This  instruction is  called by  the
   garbage-collector.  The  instruction removes the  monitor from the  variable monitoring
   table.

   (see compiler/delcode.c) */
ci_decl(remove_monitor)
{
  trace
    U32 *ticket = (U32 *)(*(MAM(m_SP)-1));
  U32 *var = (U32 *)(ticket[1]);
  U32 index = ticket[3];
  U32 *table = (U32 *)(var[3]);

  assert(table != NULL);

  table[index] = 0;
  //printf("Removing monitor at index %d\n",(int)index); fflush(stdout);
  MAM(m_IP) += 1;
}


/* Format:         get_var_monitors
Size:           1

This instruction expects a function f, a return address r and a dynamic variable v on the stack:

f r v ...

It takes  from the dynamic variable  the handlers table t  and pushes it  on the stack,
together with the  total number n of slots  (used or not used) in  this table, yielding
the following stack:

n t f r v ...

No copy is required (anyway, the table has no counter, because it is never shared).

However, if the variable has no  monitor's table, this instruction works like a return,
i.e. it pops the function f (which must be virtually deleted) and the address r from the
stack and jumps to address r.

 */


ci_decl(get_var_monitors)
{
  trace
    U32 *var = (U32 *)(*(MAM(m_SP)-3));

  //printf("get_var_monitors: var[0] = %lu var[2] = %lu var[3] = %p\n",var[0],var[2],(U32 *)var[3]);
  if (var[3] == (U32)NULL)
  {
    /* no monitor in this variable; behave like a 'ret' */
    U32 f = *(MAM(m_SP)-1);
    if (f&1)
    {
      vdelete_module_ref((U8 *)f,relative_IP(MAM(m_IP)),MAM(m_allocator));
    }
    else
    {
      if (((U32 *)f)[0]) (((U32 *)f)[0])++;
    }
    MAM(m_IP) = (U8 *)(*(MAM(m_SP)-2));
    MAM(m_SP) -= 2;
  }
  else
  {
    /* their may be monitors in this variable */
    *(MAM(m_SP)++) = var[3];   /* push the table */
    *(MAM(m_SP)++) = var[2];   /* size (number of handlers slots) */
    MAM(m_IP) += 1;
  }
}


/* The same one for multiple variables, but here the initial stack is

   f r i mv ...

   which must become:

   n t f r i mv ...

 */
ci_decl(get_mvar_monitors)
{
  trace
    U32 *mvar = (U32 *)(*(MAM(m_SP)-4));

  if (mvar[3] == (U32)NULL)
  {
    /* no monitor in this variable; behave like a 'ret' */
    MAM(m_IP) = (U8 *)(*(MAM(m_SP)-2));
    MAM(m_SP) -= 2;
  }
  else
  {

    //printf("get_mvar_monitors: mvar[0] = %d mvar[2] = %d mvar[3] = %p\n",mvar[0],mvar[2],(U32 *)mvar[3]);
    *(MAM(m_SP)++) = mvar[3];   /* push the table */
    *(MAM(m_SP)++) = mvar[2];   /* size (number of handlers slots) */
    MAM(m_IP) += 1;
  }
}


/* Format:          ret_if_zero
Size:            1

This instruction expects the following stack:

n t f r ...

where t  is a handler's  table, n the size  of this table,  and r a return  address. It
tests  if  n is  zero.  If  it is  the  case,  it  pops n, t and f from the  stack  (no
garbage-collection, except for f), and returns. Otherwise, it just decrements the top
of stack n. */
ci_decl(ret_if_zero)
{
  trace

    //printf("ret_if_zero: *(MAM(m_SP)-1) = %d\n", *(MAM(m_SP)-1));
    if (!(*(MAM(m_SP)-1)))
    {
      U32 f = *(MAM(m_SP)-3);
      if (f&1)
      {
        //printf("@@@@@@@@@ vdelete_module at IP = %\ld\n",relative_IP(MAM(m_IP))); fflush(stdout);
        vdelete_module_ref((U8 *)f,relative_IP(MAM(m_IP)),MAM(m_allocator));
      }
      else
      {
        if (((U32 *)f)[0]) (((U32 *)f)[0])++;
      }
      MAM(m_IP) = (U8 *)(*(MAM(m_SP)-4));
      MAM(m_SP) -= 4;

      //printf("after ret_if_zero: IP = %d\n",relative_IP(MAM(m_IP))); fflush(stdout);
      return;
    }
    else
    {
      (*(MAM(m_SP)-1))--;
    }
  MAM(m_IP) += 1;
}


/* Format:            get_var_handler (U32)addr
Size:              1+4

This instruction expects the following stack:

i t ...

where t is a handler's table, and i an index into that table.

t[i] is either 0 or a handler i.e. a function 'f' of type '(One -> One)'.

if t[i] is 0, there is no handler, and the instruction just performs a jump to 'addr'.

if t[i]  is not 0, it  must be an  actual handler. In that  case 'f' must be  called on
argument 'unique'. To that end, the following stack is prepared:

unique f addr i t ...

and a jump (apply) to f will be performed by next instruction. Of course a virtual copy
of f must be counted. On return of this call, MAM(m_IP) will be 'addr'. */
ci_decl(get_var_handler)
{
  trace
    U32 i = *(MAM(m_SP)-1);
  U32 *table = (U32 *)(*(MAM(m_SP)-2));
  U32 aux;

  assert(table != NULL);

  /*
     printf("get_var_handler: i = %d table = %p stack: %.8x %.8x %.8x ...\n",
     i,table,*(MAM(m_SP)-1),(U32 *)(*(MAM(m_SP)-2)),((U8 *)(*(MAM(m_SP)-3))));
     fflush(stdout);
   */

  if (table[i])
  {
    //printf("handler at %d   MAM(m_SP) = %d\n",i,MAM(m_SP)-MAM(m_SP_begin)); fflush(stdout);
    /* there is a handler pair */
    *(MAM(m_SP)++) = get32(1);                      /* push addr */
    //printf("return address pushed\n"); fflush(stdout);
    aux = table[i];                                 /* the monitor */
    *(MAM(m_SP)++) = aux;                           /* push it */
    //printf("monitor pushed\n"); fflush(stdout);
    *(MAM(m_SP)++) = 0;                             /* push 'unique' */
    //printf("unique pushed\n"); fflush(stdout);
    /* must make a virtual copy of f */
    //printf("aux = %x\n",(int)aux); fflush(stdout);
    if (aux&1)
    {
      vcopy_module_ref((U8 *)aux,relative_IP(MAM(m_IP)));
    }
    else
    {
      if (((U32 *)aux)[0]) (((U32 *)aux)[0])++;
    }

    MAM(m_IP) += 1+4;                               /* execute next instruction */
    //printf("leaving get_var_handler\n"); fflush(stdout);
    return;
  }
  else
  {
    //printf("no handler at %d   MAM(m_SP) = %d\n",i,MAM(m_SP)-MAM(m_SP_begin)); fflush(stdout);
    /* no handler pair */
    MAM(m_IP) = (U8 *)(get32(1));
    //printf("leaving get_var_handler\n"); fflush(stdout);
    return;
  }
}


/* The same for multiple variables. The difference is the stack is:

   n t f r i ...

   and must become:

   i h addr n t f r i ...

   where i is the number of the slot, and h the handler of type Word32 -> One. */
ci_decl(get_mvar_handler)
{
  trace
    U32 i = *(MAM(m_SP)-5);
  U32 n = *(MAM(m_SP)-1);
  U32 *table = (U32 *)(*(MAM(m_SP)-2));
  U32 aux;

  assert(table != NULL);

  if (table[n])
  {
    *(MAM(m_SP)++) = get32(1);                      /* push addr */
    aux = *(MAM(m_SP)++) = table[n];                /* push monitor */
    *(MAM(m_SP)++) = i;                             /* push i */
    /* must make a virtual copy of h */
    if (aux&1)
    {
      vcopy_module_ref((U8 *)aux,relative_IP(MAM(m_IP)));
    }
    else
    {
      if (((U32 *)aux)[0]) (((U32 *)aux)[0])++;
    }

    MAM(m_IP) += 1+4;                               /* execute next instruction */
    return;
  }
  else
  {
    /* no handler pair */
    MAM(m_IP) = (U8 *)(get32(1));
    return;
  }
}


/* Format:      copy_mixed (U8)mask
Size:        1+1

This instruction is the same as 'copy',  except that mixed data are concerned. The mask
provided as the unique operand enables to  determine if the alternative of the datum in
R  is  small  or  mixed.   Of  course,  the  counter  is  incremented  only  for  mixed
alternatives.

vcopy_mixed is similar,  except that the number of  copies is on the stack  and must be
removed from it. */
ci_decl(copy_mixed)
{
  U32 *ptr;
  trace
    if ((1<<((MAM(m_R))&3)) & get8(1))  /* check if alternative mixed */
    {
      ptr = (U32 *)((MAM(m_R))&pointer_mask);
      if (*ptr) (*ptr)++;  /* increment only if non permanent */
    }
  MAM(m_IP) += 1+1;
}


ci_decl(vcopy_mixed)
{
  trace
  {
    U32 *ptr;
    if ((1<<((MAM(m_R))&3)) & get8(1))  /* check if alternative mixed */
    {
      ptr = (U32 *)((MAM(m_R))&pointer_mask);
      if (*ptr) (*ptr) += *(MAM(m_SP)-1); /* don't vcopy permanent data */
    }
    MAM(m_SP)--;
  }
  MAM(m_IP) += 1+1;
}


/* Format:      copy_ptr
Size:        1

This instruction makes  a virtual copy of the  datum pointed to by R.   However, if the
datum is permanent (the counter is 0), the counter should not be changed.

vcopy_ptr is  similar except that the  number of copies is  on the stack  from which it
must be removed. */
ci_decl(copy_ptr)
{
  trace

    if (*((U32 *)(MAM(m_R))) != 0)
      (*((U32 *)(MAM(m_R))))++;
  MAM(m_IP) += 1;
}


/* Format:       copy_function
Size:         1

This instruction  is similar  to i_copy_ptr. The  sole difference  is that it  must not
perform the copy when the pointer to the function is odd (top level function).

Since version 1.13 all functions are counted, even top level functions. For a closure,
the counter is in the closure itself, but for a top level function the counter is that of
the corresponding module.

 */
ci_decl(copy_function)
{
  trace
    if (MAM(m_R)&1)
    {  /* top level function */
      vcopy_module_ref((U8 *)(MAM(m_R)),relative_IP(MAM(m_IP)));
    }
    else
    {  /* closure function */
      if (*((U32 *)(MAM(m_R))) != 0)   /* avoid copying permanent functions
                                          (however, permanent closures do not exist until now) */
        (*((U32 *)(MAM(m_R))))++;
    }
  MAM(m_IP) += 1;
}


/* Format:       copy_int
Size:         1

This  instruction is  similar to  copy_ptr. The  sole difference  is that  it  must not
perform the copy when the pointer is odd (small int). */
ci_decl(copy_int)
{
  trace
    if (!(MAM(m_R)&1))
      if (*((U32 *)(MAM(m_R)&pointer_mask)) != 0)
        (*((U32 *)(MAM(m_R)&pointer_mask)))++;
  MAM(m_IP) += 1;
}


/* perform multiple virtual copies (vcopy_?) */

ci_decl(vcopy_ptr)
{
  trace
    if (*((U32 *)(MAM(m_R))) != 0)
      (*((U32 *)(MAM(m_R)))) += *(MAM(m_SP)-1);
  MAM(m_SP)--;
  MAM(m_IP) += 1;
}


ci_decl(vcopy_function)
{
  trace
    if (MAM(m_R)&1)
    {  /* top */
      multiple_vcopy_module_ref((U8 *)MAM(m_R),*(MAM(m_SP)-1));
    }
    else
    {
      if (*((U32 *)(MAM(m_R))) != 0)
        (*((U32 *)(MAM(m_R)))) += *(MAM(m_SP)-1);
    }
  MAM(m_SP)--;             /* this was the number of copies required */
  MAM(m_IP) += 1;
}


ci_decl(vcopy_int)
{
  trace
    if (!((MAM(m_R))&1))    // if not small
    {
      U32 *ptr = (U32 *)((MAM(m_R))&pointer_mask);   // pointer to segment
      if (*ptr != 0)     // if not permanent
        *ptr += *(MAM(m_SP)-1);
    }
  MAM(m_SP)--;
  MAM(m_IP) += 1;
}


ci_decl(vcopy_null)
{
  trace
    MAM(m_SP)--;
  MAM(m_IP) += 1;
}


/* Format:      del (U32)addr
Size:        1+4

This instruction  performs a virtual deletion  of the datum  in R, which is  assumed to
belong to  a large type.   This amounts  to decrement the  counter in the  data segment
pointed to by R.  If this counter becomes  0, the datum must be really deleted. This is
achieved  by calling  the deletion  subroutine  whose address  is given  by the  unique
operand.

Of course, R may also be 0. In that case do nothing. */
ci_decl(del)
{
  trace
    if (MAM(m_SP)+3 >= MAM(m_SP_end))
    {
      MAM(m_status) = need_bigger_stack;
      MAM(m_steps) = 0;
      return;
    }

  if (MAM(m_R) &&
      (*((U32 *)((MAM(m_R))&pointer_mask))) &&
      !(--(*((U32 *)((MAM(m_R))&pointer_mask)))))
  {
    *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1+4);     /* push return address */
    *(MAM(m_SP)++) = MAM(m_R);                 /* push datum to be deleted */
    MAM(m_IP) = (U8 *)get32(1);                /* jump to deletion code */
  }
  else
  {
    MAM(m_IP) += 1+4;
  }
}


/* Format:      del_mixed (U8)mask (U32)addr
Size:        1+1+4

This  instruction is  the  same as  'del', except  that  it concerns  mixed types.  The
provided bit mask enables to determine if  the alternative of the datum is either small
or mixed.  If it is small, nothing is  done.  If it is mixed, the counter pointed to by
MAM(m_R) (pointer part) is decremented, and if it becomes 0, the deletion subroutine is
called. */
ci_decl(del_mixed)
{
  trace
    if (MAM(m_SP)+3 >= MAM(m_SP_end))
    {
      MAM(m_status) = need_bigger_stack;
      MAM(m_steps) = 0;
      return;
    }

  if (MAM(m_R) &&
      ((1<<((MAM(m_R))&3)) & get8(1)) &&
      (*((U32 *)((MAM(m_R))&pointer_mask))) &&
      !(--(*((U32 *)((MAM(m_R))&pointer_mask)))))
  {
    *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1+1+4);  /* push return address */
    *(MAM(m_SP)++) = MAM(m_R);            /* push datum to delete */
    MAM(m_IP) = (U8 *)get32(1+1);      /* jump to deletion code */
  }
  else
  {
    MAM(m_IP) += 1+1+4;
  }
}


/* Format:      del_ptr
Size:        1

This instruction virtually deletes the content of  R, which is supposed to be a pointer
to a data segment not containing any reference (for example to a string). The datum may
be permanent.

Also, the pointer may by NULL. */
ci_decl(del_ptr)
{
  trace
    if (MAM(m_R) &&                     /* if pointer not null */
        *((U32 *)MAM(m_R)) &&           /* if datum not permanent */
        !(--(*((U32 *)MAM(m_R)))))      /* if last copy */
    {
      MAM(m_allocator)->FreeDataSegment((U32 *)MAM(m_R));
    }
  MAM(m_IP) += 1;
}


/* Format:      del_conn
Size:        1

This instruction virtually deletes the content of MAM(m_R), which is a far connection (which
may be permanent). */
ci_decl(del_conn)
{
  trace
#ifdef show_conn_counts
    LOGERROR("del_conn: MAM(m_IP)=%d, count=%d\n",relative_IP(MAM(m_IP)),*((U32 *)MAM(m_R)));
  fflush(stderr);
#endif
  if (MAM(m_R) &&
      *((U32 *)MAM(m_R)) &&           /* if connection not permanent */
      !(--(*((U32 *)MAM(m_R)))))   /* if last copy */
  {
    if(close_connection((U8 *)MAM(m_R)))
      MAM(m_allocator)->FreeDataSegment((U32 *)MAM(m_R));
    else
    {
      (*((U32 *)MAM(m_R)))++;  // undo previous ref counter decrease
      MAM(m_steps) = 0;
      return;
    }
  }
  MAM(m_IP) += 1;
}


/* Format:     del_stack (U32)depth (U32)addr
Size:       1+4+4

This intruction is similar to 'i_del', except that the large datum to be deleted is not
in MAM(m_R) but in  the stack at depth 'depth'. The manipulation word  of the datum is first
copied to the auxillary register 'aux'. Then the stack is collapsed (in the same way as
'i_collapse' does),  and then the  instruction proceeds the  same way as  'i_del' using
'aux' instead of MAM(m_R). */
ci_decl(del_stack)
{
  trace
    if (MAM(m_SP)+3 >= MAM(m_SP_end))
    {
      MAM(m_status) = need_bigger_stack;
      MAM(m_steps) = 0;
      return;
    }

  /* adjust stack */
  U32 i = get32(1);          /* i = depth */
  U32 aux = (*(MAM(m_SP)-i-1));   /* aux = datum to be deleted */

#ifdef use_memmove
  /*MHMH*/
  U32 *start = MAM(m_SP)-i;
  if (i) memmove( (void *)(start-1), (void *)(start), i<<2 );
#else
  while (i)                  /* collapse stack */
  {
    *(MAM(m_SP)-i-1) = *(MAM(m_SP)-i);
    i--;
  }
#endif
  MAM(m_SP)--;

  if (aux &&
      (*((U32 *)(aux&pointer_mask))) &&
      !(--(*((U32 *)(aux&pointer_mask)))))
  {
    /* deletion code will not overwrite MAM(m_R) */
    *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1+4+4);    /* push return address */
    *(MAM(m_SP)++) = aux;                /* push datum to delete */
    MAM(m_IP) = (U8 *)get32(1+4);        /* jump to deletion code */
  }
  else
  {
    MAM(m_IP) += 1+4+4;
  }
}


/* Format:         del_stack_mvar (U32)depth (U32)addr
Size:           1+4+4

This instruction  is similar to i_del_stack,  except that the  datum in the stack  is a
multiple variable. */
ci_decl(del_stack_mvar)
{
  trace

    if (MAM(m_SP)+3 >= MAM(m_SP_end))
    {
      MAM(m_status) = need_bigger_stack;
      MAM(m_steps) = 0;
      return;
    }

  /* adjust stack */
  U32 i = get32(1);        /* i = depth */
  //printf("depth = %d addr = %d\n",i,relativ_IP((U8 *)(get32(5)))); fflush(stdout);
  U32 aux = (*(MAM(m_SP)-i-1));   /* aux = datum to be deleted */


#ifdef use_memmove
  /*MHMH*/
  U32 *start = MAM(m_SP)-i;
  if (i) memmove( (void *)(start-1), (void *)(start), i<<2 );
#else
  while (i)                  /* collapse stack */
  {
    *(MAM(m_SP)-i-1) = *(MAM(m_SP)-i);
    i--;
  }
#endif

  MAM(m_SP)--;

  if (aux &&
      (*((U32 *)(aux&pointer_mask))) &&
      !(--(*((U32 *)(aux&pointer_mask)))))
  {
    /* deletion code will not overwrite MAM(m_R) */
    *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1+4+4);    /* push return address */
    *(MAM(m_SP)++) = aux;                /* push datum to delete */
    MAM(m_IP) = (U8 *)get32(1+4);        /* jump to deletion code */
  }
  else
  {
    MAM(m_IP) += 1+4+4;
  }
}


/* Format:      del_stack_mixed (U32)depth (U8)mask (U32)addr
Size:        1+4+1+4

This instruction  is the  same as  'i_del_stack', except that  it concerns  mixed types
instead of large types.  The sole difference is that the counter is decremented only if
the  datum  belongs  to  a  mixed  alternative,  and not  if  it  belongs  to  a  small
alternative. */
ci_decl(del_stack_mixed)
{
  trace
    /* check stack */
    if (MAM(m_SP)+3 >= MAM(m_SP_end))
    {
      MAM(m_status) = need_bigger_stack;
      MAM(m_steps) = 0;
      return;
    }

  /* adjust stack */
  U32 i = get32(1);             /* i = depth */
  U32 aux = (*(MAM(m_SP)-i-1));        /* aux = datum to be deleted */

#ifdef use_memmove
  /*MHMH*/
  U32 *start = MAM(m_SP)-i;
  if (i) memmove( (void *)(start-1), (void *)(start), i<<2 );
#else
  while (i)                  /* collapse stack */
  {
    *(MAM(m_SP)-i-1) = *(MAM(m_SP)-i);
    i--;
  }
#endif
  MAM(m_SP)--;

  /*
     if (aux &&
     ((1<<(aux&3)) & get8(1+4)))
     {
     printf("\naux = %d aux&3 = %d *((U32 *)(aux&pointer_mask)) = %d",
     aux, aux&3, *((U32 *)(aux&pointer_mask)));
     fflush(stdout);
     }
   */

  /* delete virtually */
  if (aux &&                                 /* if pointer non null */
      ((1<<(aux&3)) & get8(1+4)) &&          /* if alternative mixed */
      (*((U32 *)(aux&pointer_mask))) &&
      !(--(*((U32 *)(aux&pointer_mask)))))
  {
    /* deletion code will not overwrite MAM(m_R) */
    *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1+4+1+4);   /* push return address */
    *(MAM(m_SP)++) = aux;                 /* push datum to delete */
    MAM(m_IP) = (U8 *)get32(1+4+1);       /* jump to deletion code */
  }
  else
  {
    MAM(m_IP) += 1+4+1+4;
  }
}


/* Format:     del_stack_ptr (U32)depth
Size:       1+4

This instruction  virtually deletes  the datum at  depth 'depth'  in the stack  (if the
datum is not permanent). If virtually deleting last copy, the datum is freed.

The datum is assumed to be a  simple data segment containing no reference (for example:
a string). */
ci_decl(del_stack_ptr)
{
  trace
    U32 i = get32(1);                              /* depth in stack */
  U32 aux = (*(MAM(m_SP)-i-1));                  /* get the pointer */

#ifdef use_memmove
  /*MHMH*/
  U32 *start = MAM(m_SP)-i;
  if (i) memmove( (void *)(start-1), (void *)(start), i<<2 );
#else
  while (i)                  /* collapse stack */
  {
    *(MAM(m_SP)-i-1) = *(MAM(m_SP)-i);
    i--;
  }
#endif
  MAM(m_SP)--;

  //printf("del_stack_ptr (%d) [%p]\n",(int)(*(((U32 *)aux)-1)),((U32 *)aux));
  //printf("aux = %d\n",(int)aux);
  //printf("*aux = %d\n",(int)(*((U32 *)aux)));
  //fflush(stdout);
  if (aux &&                                  /* beware of null pointer */
      (*((U32 *)aux)) &&                      /* don't do for permanent data */
      !(--(*((U32 *)aux))))                   /* delete virtually */
  {
    //printf("freeing.\n"); fflush(stdout);
    MAM(m_allocator)->FreeDataSegment((U32 *)aux);      /* delete really */
  }
  MAM(m_IP) += 1+4;                                  /* next instruction */
  //printf("exiting 'del_stack_ptr'.\n"); fflush(stdout);
}


/* Format:          del_stack_function (U32)<depth>
Size:            1+4

This instruction deletes a virtual copy of  the function which is in the stack at depth
<depth>.  Nothing is to  be done  if the  function is  a top  level function  (i.e. the
function is an odd word).

On the contrary, if  the function is a closure (even word), the  counter at offset 0 in
the segment must be  decremented if non zero. If the counter  becomes zero, a fake copy
of the closure must be push on the stack and the deletion code at word offset 2
in the  closure must be  called (this will  put the stack in  the same state  as before
pushing the fake copy of the closure). */
ci_decl(del_stack_function)
{
  trace
    U32 i = get32(1);       /* depth of function in then stack */
  U32 aux = (*(MAM(m_SP)-i-1));      /* the function itself */

#ifdef use_memmove
  /*MHMH*/
  U32 *start = MAM(m_SP)-i;
  if (i) memmove( (void *)(start-1), (void *)(start), i<<2 );
#else
  while (i)                  /* collapse stack */
  {
    *(MAM(m_SP)-i-1) = *(MAM(m_SP)-i);
    i--;
  }
#endif
  MAM(m_SP)--;

  /*
     if (aux&1) printf("\ndel_stack_function: deleting top level function.");
     else       printf("\ndel_stack_function: deleting |-> function.");
     fflush(stdout);
   */

  /* virtual deletion of function */
  if (aux)                /* beware of NULL pointers */
  {
    if (aux&1)
    { /* top level function */
      vdelete_module_ref((U8 *)aux,relative_IP(MAM(m_IP)),MAM(m_allocator));
    }
    else
    { /* closure function */
      if (*((U32 *)aux) &&      /* don't delete if permanent */
          !(--(*((U32 *)aux))))
      {
        /* call micro context deletion code */
        *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1+4);
        *(MAM(m_SP)++) = aux;
        MAM(m_IP) = (U8 *)(((U32 *)aux)[2]);
        return;
      }
    }
  }
  MAM(m_IP) += 1+4;
}


/* Format:          del_stack_int (U32)<depth>
Size:            1+4

This instruction deletes a  virtual copy of the integer which is  in the stack at depth
<depth>.  Nothing  is to be done  if the integer is  small (i.e. the integer  is an odd
word).

On the  contrary, if the  integer is big  (even word), the counter  at offset 0  in the
segment must be  decremented if non zero.  If the counter becomes zero,  the segment of
the integer must be freed.

Warning: don't forget to use pointer_mask, because bit 1 is the sign bit ! */
ci_decl(del_stack_int)
{
  trace
    U32 i = get32(1);                  /* depth of integer in then stack */
  U32 aux = (*(MAM(m_SP)-i-1));      /* the integer itself */

  //show_int(aux);

#ifdef use_memmove
  /*MHMH*/
  U32 *start = MAM(m_SP)-i;
  if (i) memmove( (void *)(start-1), (void *)(start), i<<2 );
#else
  while (i)                  /* collapse stack */
  {
    *(MAM(m_SP)-i-1) = *(MAM(m_SP)-i);
    i--;
  }
#endif
  MAM(m_SP)--;

  /* virtual deletion of the integer */
  if (aux &&                               /* beware of NULL pointers */
      !(aux&1) &&                          /* don't delete small integers */
      *((U32 *)(aux&pointer_mask)) &&      /* don't delete if permanent */
      !(--(*((U32 *)(aux&pointer_mask)))))
  {
    /* free the segment of the integer */
    MAM(m_allocator)->FreeDataSegment((U32 *)(aux&pointer_mask));
  }
  MAM(m_IP) += 1+4;
}


/* Format:     del_stack_struct_ptr (U8)struct_id (U32)depth
Size:       1+1+4

Same  as i_del_stack_ptr,  except then  the  segment contains  a pointer  to a  C
structure at byte offset 4. */
ci_decl(del_stack_struct_ptr)
{
  trace
    U32 i = get32(2);                              /* depth in stack */
  U32 aux = (*(MAM(m_SP)-i-1));                         /* get the pointer */


#ifdef use_memmove
  /*MHMH*/
  U32 *start = MAM(m_SP)-i;
  if (i) memmove( (void *)(start-1), (void *)(start), i<<2 );
#else
  while (i)                  /* collapse stack */
  {
    *(MAM(m_SP)-i-1) = *(MAM(m_SP)-i);
    i--;
  }
#endif

  MAM(m_SP)--;

  /*
     if (aux)
     {
     fprintf(stdout,"del_stack_struct_ptr: ptr = %p MAM(m_IP) = %d, struct_id = %d, cnt = %d\n",
     (void *)aux, relative_IP(MAM(m_IP)), get8(1),(*(U32 *)aux));
     fflush(stdout);
     }
   */

  if (aux &&                                  /* beware of null pointer */
      *((U32 *)aux) &&                        /* don't do for permanent data */
      !(--(*((U32 *)aux))))                   /* delete virtually */
  {
    free_C_structure((void *)(((U32 *)aux)[1]),get8(1), MAM(m_allocator));
    MAM(m_allocator)->FreeDataSegment((U32 *)aux);      /* delete really */
  }
  MAM(m_IP) += 1+1+4;                                  /* next instruction */
}


/* Format:     del_stack_conn (U32)depth
Size:       1+4

This instruction virtually deletes the connection at depth 'depth' in the stack (if the
connection is not permanent).  If virtually deleting last copy, the connection is freed
(and closed). */
ci_decl(del_stack_conn)
{
  trace
    if (MAM(m_duc_non_empty))
    {
      if(close_connection((U8 *)MAM(m_DUC1)))
      {
        MAM(m_allocator)->FreeDataSegment((U32 *)MAM(m_DUC1));
        MAM(m_DUC1) = 0;
        MAM(m_duc_non_empty) = 0;
      }
      else
      {
        MAM(m_steps) = 0;
        return;
      }
    }
    else
    {
      U32 i = get32(1);
      U32 aux = (*(MAM(m_SP)-i-1));

#ifdef use_memmove
      /*MHMH*/
      U32 *start = MAM(m_SP)-i;
      if (i) memmove( (void *)(start-1), (void *)(start), i<<2 );
#else
      while (i)                  /* collapse stack */
      {
        *(MAM(m_SP)-i-1) = *(MAM(m_SP)-i);
        i--;
      }
#endif
      MAM(m_SP)--;

#ifdef show_conn_counts
      LOGERROR("del_stack_conn: MAM(m_IP)=%d, count=%d\n",relative_IP(MAM(m_IP)), aux ? *((U32 *)aux) : 0);
      fflush(stderr);
#endif
      if (aux &&
          *((U32 *)aux) &&
          !(--(*((U32 *)aux))))
      {
        if(close_connection((U8 *)aux))
          MAM(m_allocator)->FreeDataSegment((U32 *)aux);
        else
        {
          MAM(m_DUC1) = aux;
          MAM(m_duc_non_empty) = 1;
          MAM(m_steps) = 0;
          return;
        }
      }
    }
  MAM(m_IP) += 1+4;
}


/* Format:      del_index_direct
Size:        1

This instruction  is similar to 'index_direct',  except that it concerns  a mixed datum
which is not in R but on top of stack.

Furthermore, the instruction  must erase the index  from the word on top  of stack, and
duplicate the top of  stack.  Hence, if the stack is the  following before execution of
this instruction:

pi x y z ...

where pi is  the combination of a two bits  index i and a 30 bits  pointer p, the stack
will be the following after execution:

p  p  x y z ...

and i is put into I.

The reason for the duplication of the pointer  is that we need to increment it in order
to walk into the data segment, and we also need to keep it for 'free_seg_1'. */
ci_decl(del_index_direct)
{
  trace
    MAM(m_I) = (U8)((*(MAM(m_SP)-1))&3);    /* get the index (width=2) */
  *(MAM(m_SP)-1) &= pointer_mask;         /* mask out the index */
  *MAM(m_SP) = *(MAM(m_SP)-1);            /* duplicate the pointer */
  MAM(m_SP)++;                            /* update stack pointer */
  MAM(m_IP) += 1;
}


/* Format:      del_index_indirect
Size:        1

This  instruction is similar  to 'del_index_direct',  except that  it concerns  a large
datum.  The  index is got from  the data segment,  not from the manipulation  word. The
pointer is also duplicated on top of stack. */
ci_decl(del_index_indirect)
{
  trace
    MAM(m_I) = *(((U8 *)(*(MAM(m_SP)-1)))+4);   /* get the index */
  *MAM(m_SP) = *(MAM(m_SP)-1);                /* duplicate the pointer */
  MAM(m_SP)++;
  MAM(m_IP) += 1;
}


/* Format:      increment_del (U8)depl
Size:        1+1

This  instruction  increments  the pointer  on  top  of  stack,  by  the value  of  the
operand. It is  used to walk into  the data segment whose components  must be virtually
deleted.

Note:  The compiler  always produces  depl=1,  2 or  4. But  peephole optimization  may
combine such consecutive instructions into a single one by adding the operands. */
ci_decl(increment_del)
{
  trace
    ((*(MAM(m_SP)-1))) += get8(1);
  MAM(m_IP) += 1+1;
}


/* Format:      indirect_del (U32)addr
Size:        1+4

This  instruction performs a  virtual deletion  of the  large datum  pointed to  by the
pointer on  top of stack.  If the  counter becomes 0,  the real deletion  subroutine is
called.

The pointer may also be null. */
ci_decl(indirect_del)
{
  trace
    if (MAM(m_SP)+3 >= MAM(m_SP_end))
    {
      MAM(m_status) = need_bigger_stack;
      MAM(m_steps) = 0;
      return;
    }

  U32 aux = *((U32 *)(*(MAM(m_SP)-1)));

  if (aux &&
      (*((U32 *)(aux&pointer_mask))) &&
      !(--(*((U32 *)(aux&pointer_mask)))))
  {                                  /* if decremented to zero */
    *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1+4);         /* push return address */
    *(MAM(m_SP)++) = aux;                   /* push datum */
    MAM(m_IP) = (U8 *)get32(1);             /* delete */
  }
  else
  {
    MAM(m_IP) += 1+4;
  }
}


/* Format:      incr_indirect_del (U32)addr (U8)depl
Size:        1+4+1

Same as indirect_del, but performs first a increment_del depl.
 */
ci_decl(incr_indirect_del)
{
  trace
    if (MAM(m_SP)+3 >= MAM(m_SP_end))
    {
      MAM(m_status) = need_bigger_stack;
      MAM(m_steps) = 0;
      return;
    }

  ((*(MAM(m_SP)-1))) += get8(5);                /* increment the pointer */

  U32 aux = *((U32 *)(*(MAM(m_SP)-1)));

  if (aux &&
      (*((U32 *)(aux&pointer_mask))) &&
      !(--(*((U32 *)(aux&pointer_mask)))))
  {                                           /* if decremented to zero */
    *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1+4+1);  /* push return address */
    *(MAM(m_SP)++) = aux;                     /* push datum */
    MAM(m_IP) = (U8 *)get32(1);               /* delete */
  }
  else
  {
    MAM(m_IP) += 1+4+1;                       /* next instruction */
  }
}


/* Format:      indirect_del_mvar (U32)addr
Size:        1+4;

 */
ci_decl(indirect_del_mvar)
{
  trace
    if (MAM(m_SP)+3 >= MAM(m_SP_end))
    {
      MAM(m_status) = need_bigger_stack;
      MAM(m_steps) = 0;
      return;
    }

  U32 aux = *((U32 *)(*(MAM(m_SP)-1)));

  if (aux &&
      (*((U32 *)(aux&pointer_mask))) &&
      !(--(*((U32 *)(aux&pointer_mask)))))
  {                                                /* if decremented to zero */
    *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1+4);         /* push return address */
    *(MAM(m_SP)++) = aux;                          /* push datum */
    MAM(m_IP) = (U8 *)get32(1);                    /* delete */
  }
  else
  {
    MAM(m_IP) += 1+4;
  }
}


/* Format:      indirect_del_mvar (U32)addr (U8)depl
Size:        1+4+1;

Same as above but increments the pointer first. */
ci_decl(incr_indirect_del_mvar)
{
  trace
    if (MAM(m_SP)+3 >= MAM(m_SP_end))
    {
      MAM(m_status) = need_bigger_stack;
      MAM(m_steps) = 0;
      return;
    }

  ((*(MAM(m_SP)-1))) += get8(5);

  U32 aux = *((U32 *)(*(MAM(m_SP)-1)));

  if (aux &&
      (*((U32 *)(aux&pointer_mask))) &&
      !(--(*((U32 *)(aux&pointer_mask)))))
  {                                  /* if decremented to zero */
    *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1+4+1);         /* push return address */
    *(MAM(m_SP)++) = aux;                   /* push datum */
    MAM(m_IP) = (U8 *)get32(1);             /* delete */
  }
  else
  {
    MAM(m_IP) += 1+4+1;
  }
}


/* Format:        indirect_del_mixed (U8)mask (U32)addr
Size:          1+1+4

This instruction is  similar to 'i_indirect_del', except that  it concerns mixed types.
The counter is decremented only if the datum belongs to a mixed alternative. */
ci_decl(indirect_del_mixed)
{
  trace
    if (MAM(m_SP)+3 >= MAM(m_SP_end))
    {
      MAM(m_status) = need_bigger_stack;
      MAM(m_steps) = 0;
      return;
    }

  U32 aux = *((U32 *)(*(MAM(m_SP)-1)));           /* datum to be deleted
                                                   */
#ifdef debug_vm
  if(debugging)
  {
    LOGINFO("\nDatum to be deleted: %d mask: %d",aux,get8(1));
    fflush(stdout);
  }
#endif
  if ( aux &&
      ((1<<(aux&3)) & get8(1)) &&     /* check if alternative is mixed */
      (*((U32 *)(aux&pointer_mask))) &&
      !(--(*((U32 *)(aux&pointer_mask)))))   /* decrement reference counter */
  {                                  /* if decremented to zero */
    *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1+1+4);       /* push return address */
    *(MAM(m_SP)++) = aux;                   /* push datum */
    MAM(m_IP) = (U8 *)get32(1+1);           /* delete */
  }
  else
    MAM(m_IP) += 1+1+4;
}


/* Format:        incr_indirect_del_mixed (U8)mask (U32)addr (U8)depl
Size:          1+1+4+1

Same as above but increments the pointer first. */
ci_decl(incr_indirect_del_mixed)
{
  trace
    if (MAM(m_SP)+3 >= MAM(m_SP_end))
    {
      MAM(m_status) = need_bigger_stack;
      MAM(m_steps) = 0;
      return;
    }

  ((*(MAM(m_SP)-1))) += get8(6);

  U32 aux = *((U32 *)(*(MAM(m_SP)-1)));           /* datum to be deleted
                                                   */
#ifdef debug_vm
  if(debugging)
  {
    LOGINFO("\nDatum to be deleted: %d mask: %d",aux,get8(1));
    fflush(stdout);
  }
#endif
  if ( aux &&
      ((1<<(aux&3)) & get8(1)) &&     /* check if alternative is mixed */
      (*((U32 *)(aux&pointer_mask))) &&
      !(--(*((U32 *)(aux&pointer_mask)))))   /* decrement reference counter */
  {                                  /* if decremented to zero */
    *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1+1+4+1);       /* push return address */
    *(MAM(m_SP)++) = aux;                   /* push datum */
    MAM(m_IP) = (U8 *)get32(1+1);           /* delete */
  }
  else
    MAM(m_IP) += 1+1+4+1;
}


/* Format:        indirect_del_ptr
Size:          1

This instruction virtually deletes the datum whose manipulation word (address of datum)
is pointed  to by  pointer on top  of stack (if  the datum  is not permanent).   If the
counter becomes 0, the data segment of the datum is freed. */
ci_decl(indirect_del_ptr)
{
  trace
    U32 aux = *((U32 *)*(MAM(m_SP)-1));   /* pointer (manipulation word) to datum to be deleted */

  if (aux &&
      *((U32 *)aux) &&
      !(--(*((U32 *)aux))))
  {
    MAM(m_allocator)->FreeDataSegment((U32 *)aux);
  }
  MAM(m_IP) += 1;
}


/* Format:        incr_indirect_del_ptr (U8)depl
Size:          1+1

This instruction is the same as  indirect_del_ptr, but it first advances the pointer by
depl. */
ci_decl(incr_indirect_del_ptr)
{
  trace

    ((*(MAM(m_SP)-1))) += get8(1);        /* advance the pointer */

  U32 aux = *((U32 *)*(MAM(m_SP)-1));   /* pointer (manipulation word) to datum to be deleted */

  if (aux &&
      *((U32 *)aux) &&
      !(--(*((U32 *)aux))))
  {
    MAM(m_allocator)->FreeDataSegment((U32 *)aux);
  }
  MAM(m_IP) += 1+1;
}


/* Format:        indirect_del_function
Size:          1

This instruction virtually  deletes the function whose manipulation  word is pointed to
by pointer  on top  of stack. If  the function  is top level,  or a  permanent closure,
nothing is  done. Otherwise, the  counter is decremented,  and if it becomes  zero, the
closure is garbage-collected. */
ci_decl(indirect_del_function)
{
  trace
    U32 aux = *((U32 *)*(MAM(m_SP)-1));   /* pointer (manipulation word) to function */
  if (aux)
  {
    if (aux&1)
    { /* top level function */
      vdelete_module_ref((U8 *)aux,relative_IP(MAM(m_IP)),MAM(m_allocator));
    }
    else
    { /* closure function */
      if (*((U32 *)aux) &&
          !(--(*((U32 *)aux))))
      {
        /* call closure deletion code */
        *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1);
        *(MAM(m_SP)++) = aux;
        MAM(m_IP) = (U8 *)(((U32 *)aux)[2]);
        return;
      }
    }
  }
  MAM(m_IP) += 1;
}


/* Format:        incr_indirect_del_function (U8)depl
Size:          1+1

Same as above but increments the pointer first. */
ci_decl(incr_indirect_del_function)
{
  trace

    ((*(MAM(m_SP)-1))) += get8(1);

  U32 aux = *((U32 *)*(MAM(m_SP)-1));   /* pointer (manipulation word) to function */
  if (aux)
  {
    if (aux&1)
    { /* top level function */
      vdelete_module_ref((U8 *)aux,relative_IP(MAM(m_IP)),MAM(m_allocator));
    }
    else
    { /* closure function */
      if (*((U32 *)aux) &&
          !(--(*((U32 *)aux))))
      {
        /* call closure deletion code */
        *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1+1);
        *(MAM(m_SP)++) = aux;
        MAM(m_IP) = (U8 *)(((U32 *)aux)[2]);
        return;
      }
    }
  }
  MAM(m_IP) += 1+1;
}


/* Format:        indirect_del_int
Size:          1

This instruction virtually deletes the integer whose manipulation word is pointed to by
pointer on top of  stack. If the integer is small, or  a permanent big integer, nothing
is done. Otherwise, the counter is decremented,  and if it becomes zero, the integer is
garbage-collected. */
ci_decl(indirect_del_int)
{
  trace
    U32 aux = *((U32 *)*(MAM(m_SP)-1));   /* the integer */

  if (aux &&
      !(aux&1) &&
      *((U32 *)(aux&pointer_mask)) &&
      !(--(*((U32 *)(aux&pointer_mask)))))
  {
    /* free the segment of the integer */
    MAM(m_allocator)->FreeDataSegment((U32 *)(aux&pointer_mask));
  }
  MAM(m_IP) += 1;
}

/* Format:        incr_indirect_del_int (U8)depl
Size:          1+1

Same as above but increments the pointer first. */
ci_decl(incr_indirect_del_int)
{
  trace

    ((*(MAM(m_SP)-1))) += get8(1);

  U32 aux = *((U32 *)*(MAM(m_SP)-1));   /* the integer */

  if (aux &&
      !(aux&1) &&
      *((U32 *)(aux&pointer_mask)) &&
      !(--(*((U32 *)(aux&pointer_mask)))))
  {
    /* free the segment of the integer */
    MAM(m_allocator)->FreeDataSegment((U32 *)(aux&pointer_mask));
  }
  MAM(m_IP) += 1+1;
}


/*
   The same one, but with the function in MAM(m_R).
 */
ci_decl(del_function)
{
  trace
    if (MAM(m_R))         /* avoid pseudo-datum 0 */
    {
      if (MAM(m_R)&1)
      { /* top level function */
        vdelete_module_ref((U8 *)(MAM(m_R)),relative_IP(MAM(m_IP)),MAM(m_allocator));
      }
      else
      { /* closure function */
        if (*((U32 *)MAM(m_R)) &&
            !(--(*((U32 *)MAM(m_R)))))
        {
          /* call closure deletion code */
          *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1);
          *(MAM(m_SP)++) = MAM(m_R);
          MAM(m_IP) = (U8 *)(((U32 *)MAM(m_R))[2]);
          return;
        }
      }
    }
  MAM(m_IP) += 1;
}

ci_decl(del_int)
{
  trace
    if (MAM(m_R) &&
        !(MAM(m_R)&1) &&
        *((U32 *)(MAM(m_R)&pointer_mask)) &&
        !(--(*((U32 *)(MAM(m_R)&pointer_mask)))))
    {
      MAM(m_allocator)->FreeDataSegment((U32 *)((MAM(m_R)&pointer_mask)));
    }
  MAM(m_IP) += 1;
}


/* Format:        indirect_del_struct_ptr (U8)struct_id
Size:          1+1

This is the same  as for indirect_del_ptr, except that the pointer  points to a segment
with:

offset 0:     counter
offset 1:     pointer to C structure

The pointer to C  structure must be deleted (if the counter  reaches 0) with a specific
tool. */
ci_decl(indirect_del_struct_ptr)
{
  trace
    U32 aux = *((U32 *)*(MAM(m_SP)-1));   /* pointer (manipulation word) to datum to be deleted */
  if (aux &&
      *((U32 *)aux) &&
      !(--(*((U32 *)aux))))
  {
    free_C_structure((void *)(((U32 *)aux)[1]),get8(1),MAM(m_allocator));
    MAM(m_allocator)->FreeDataSegment((U32 *)aux);
  }
  MAM(m_IP) += 1+1;
}


/* Format:        incr_indirect_del_struct_ptr (U8)struct_id (U8)depl
Size:          1+1+1

Same as above but increments the pointer first. */
ci_decl(incr_indirect_del_struct_ptr)
{
  trace

    ((*(MAM(m_SP)-1))) += get8(2);

  U32 aux = *((U32 *)*(MAM(m_SP)-1));   /* pointer (manipulation word) to datum to be deleted */
  if (aux &&
      *((U32 *)aux) &&
      !(--(*((U32 *)aux))))
  {
    free_C_structure((void *)(((U32 *)aux)[1]),get8(1),MAM(m_allocator));
    MAM(m_allocator)->FreeDataSegment((U32 *)aux);
  }
  MAM(m_IP) += 1+1+1;
}


/* Format:        indirect_del_conn
Size:          1

This instruction virtually  deletes the connection whose manipulation  word (address of
connection)  is pointed  to  by pointer  on  top of  stack (if  the  connection is  not
permanent). If the counter becomes 0, the  data segment of the connection is freed (and
the connection is closed). */
ci_decl(indirect_del_conn)
{
  trace
    U32 aux = *((U32 *)*(MAM(m_SP)-1));   /* pointer (manipulation word) to connection to be deleted */

#ifdef show_conn_counts
  LOGERROR("indirect_del_conn: MAM(m_IP)=%d, count=%d\n",
      relative_IP(MAM(m_IP)), aux ? *((U32 *)aux) : 0);
  fflush(stderr);
#endif
  if (aux &&
      *((U32 *)aux) &&
      !(--(*((U32 *)aux))))
  {
    if(close_connection((U8 *)aux))
      MAM(m_allocator)->FreeDataSegment((U32 *)aux);
    else
    {
      (*((U32 *)aux))++;  // undo previous ref counter decrease
      MAM(m_steps) = 0;
      return;
    }
  }
  MAM(m_IP) += 1;
}


/* Format:        incr_indirect_del_conn (U8)depl
Size:          1+1

Same as above but increments the pointer first. */
ci_decl(incr_indirect_del_conn)
{
  trace

    ((*(MAM(m_SP)-1))) += get8(1);

  U32 aux = *((U32 *)*(MAM(m_SP)-1));   /* pointer (manipulation word) to connection to be deleted */

#ifdef show_conn_counts
  LOGERROR("indirect_del_conn: MAM(m_IP)=%d, count=%d\n",
      relative_IP(MAM(m_IP)), aux ? *((U32 *)aux) : 0);
  fflush(stderr);
#endif
  if (aux &&
      *((U32 *)aux) &&
      !(--(*((U32 *)aux))))
  {
    close_connection((U8 *)aux);
    MAM(m_allocator)->FreeDataSegment((U32 *)aux);
  }
  MAM(m_IP) += 1+1;
}


/* Format:      eq (U32)depth
Size:        1+4

This instruction test the equality of the  two words at depths 'depth' and 'depth'+1 in
the stack.   The register R  is set  to 1 (true)  if they are  equal, and to  0 (false)
otherwise.

 */
ci_decl(eq)
{
  trace
    MAM(m_R) = !!((*(MAM(m_SP)-get32(1)-1)) == (*(MAM(m_SP)-get32(1)-2)));
  MAM(m_IP) += 1+4;
}


/* Equality for Strings */
ci_decl(eq_string)
{
  trace
    char *s1 = ((char *)(*(MAM(m_SP)-1)))+4;
  char *s2 = ((char *)(*(MAM(m_SP)-2)))+4;
  MAM(m_R) = (strcmp(s1,s2) ? 0 : 1);
  MAM(m_IP) += 1;
}


ci_decl(eq_byte_array)
{
  trace
    U8 *ba1 = (U8 *)(*(MAM(m_SP)-1));
  U8 *ba2 = (U8 *)(*(MAM(m_SP)-2));

  MAM(m_R) = 0;

  if (((U32 *)ba1)[1] == ((U32 *)ba2)[1])   /* same size */
  {
    U32 last = (((U32 *)ba1)[1])+8;

    /*MHMH*/
#ifdef use_memcmp
    if(memcmp(ba1+8, ba2+8, last-8))
    { /* differs */ }
    else
    { /* equal */
      MAM(m_R) = 1;
    }
#else
    U32 i;
    for (i = 8; i < last; i++)
      if (ba1[i] != ba2[i]) break;
    if (i == last)
      MAM(m_R) = 1;
#endif
  }

  MAM(m_IP) += 1;
}


/* Format:      push_eq_data
Size:        1

Note: this instruction is changed in version 1.13, because the stack contains one more
word when this instruction is called.

This instruction pushes into the stack the two manipulation words pointed to by the two
pointers at *(MAM(m_SP)-3) and *(MAM(m_SP)-4).

Note: *(MAM(m_SP)-2) is a return address 'r', and *(MAM(m_SP)-1) is the equality code
('=' below) itself seen as a function (this is what is new in version 1.13).  Hence,
if the stack is:

= r p q ...

where p and q are two pointers, it becomes:

x y = r p q ...

where x is *p and y is *q.

There is no stack checking to perform (see eqcode.c, where a (check_stack . 3) has been
replaced by a (check_stack . 4) in version 1.13). */
ci_decl(push_eq_data)
{
  trace
    U32 aux = *((U32 *)(*(MAM(m_SP)-4)));
  *(MAM(m_SP)++) = aux;
  aux = *((U32 *)(*(MAM(m_SP)-4)));  /* MAM(m_SP)-4 again because 'y' has been pushed */
  *(MAM(m_SP)++) = aux;
  MAM(m_IP) += 1;
}


/* Format:      false_jmp (U32)addr
   true_jmp (U32)addr
Size:        1+4

This instruction puts 0 (false) or 1  (true) into R, and jumps (unconditionally) to the
address given by the operand. */
ci_decl(false_jmp)
{
  trace
    MAM(m_R) = 0;
  MAM(m_IP) = (U8 *)get32(1);
}

ci_decl(true_jmp)
{
  trace
    MAM(m_R) = 1;
  MAM(m_IP) = (U8 *)get32(1);
}


/* Format:     increment_eq (U8)depl
Size:       1+1

This instruction increments by the values of 'depl' the two pointers on top of stack.

These pointers are used  to walk in parallel into two data  segments for the purpose of
comparison. */
ci_decl(increment_eq)
{
  trace
    *(MAM(m_SP)-1) += get8(1);
  *(MAM(m_SP)-2) += get8(1);
  MAM(m_IP) += 1+1;
}


/* Format:      jmp_eq_stack (U32)addr
Size:        1+4

This instruction compares the two words on top of stack, puts 1 (true) in R if they are
equal and performs a jump to 'addr'.  Otherwise the next instruction is executed, and R
remains empty.
 */
ci_decl(jmp_eq_stack)
{
  trace
    if (*(MAM(m_SP)-1) == *(MAM(m_SP)-2))
    {
      MAM(m_R) = 1;
      MAM(m_IP) = (U8 *)get32(1);
    }
    else
      MAM(m_IP) += 1+4;
}


/* Format:      jmp_false (U32)addr
Size:        1+4

This instruction should not be confused with 'false_jmp'.

It tests if R is 0 (false). If it is the case, it jumps to 'addr'. */
ci_decl(jmp_false)
{
  trace
    if (MAM(m_R) == 0)
      MAM(m_IP) = (U8 *)get32(1);
    else
      MAM(m_IP) += 1+4;
}


/* Format:      jmp_neq_0 (U32)addr
   jmp_neq_1 (U32)addr
   jmp_neq_2 (U32)addr
   jmp_neq_4 (U32)addr
Size:         1+4

This instruction compares the two 0 bits words (jmp_neq_0) 8 bits words (jmp_neq_1), 16
bits words (jmp_neq_2) or  32 bits words (jmp_neq_4) pointed to by  the two pointers on
top of stack. The  jump to 'addr' is performed if they are non  equal, and 0 (false) is
put in R.  If they are equal, the next instruction is executed. */
ci_decl(jmp_neq_0)
{
  trace
    /* zero bits wide words are always equal */
    MAM(m_IP) += 1+4;
}

ci_decl(jmp_neq_1)
{
  trace
    if (*((U8 *)(*(MAM(m_SP)-1))) != *((U8 *)(*(MAM(m_SP)-2))))
    {
      MAM(m_R) = 0;
      MAM(m_IP) = (U8 *)get32(1);
    }
    else
      MAM(m_IP) += 1+4;
}

ci_decl(jmp_neq_2)
{
  trace
    if (*((U16 *)(*(MAM(m_SP)-1))) != *((U16 *)(*(MAM(m_SP)-2))))
    {
      MAM(m_R) = 0;
      MAM(m_IP) = (U8 *)get32(1);
    }
    else
      MAM(m_IP) += 1+4;
}

ci_decl(jmp_neq_4)
{
  trace
    if (*((U32 *)(*(MAM(m_SP)-1))) != *((U32 *)(*(MAM(m_SP)-2))))
    {
      MAM(m_R) = 0;
      MAM(m_IP) = (U8 *)get32(1);
    }
    else
      MAM(m_IP) += 1+4;
}


/* Format:        jmp_neq_indexes_large (U32)addr
Size:          1+4

This instruction compares  the two indexes in  the data segments pointed to  by the two
pointers on top  of stack.  The indexes are  at offset 4 in the data  segments.  If the
indexes  are non  equal the  jump  to 'addr'  is performed,  and  0 (false)  is put  in
R. Otherwise, the common index is put in I. */
ci_decl(jmp_neq_indexes_large)
{
  trace
    if (*(((U8 *)(*(MAM(m_SP)-1)))+4) != *(((U8 *)(*(MAM(m_SP)-2)))+4))
    {
      MAM(m_R) = 0;
      MAM(m_IP) = (U8 *)get32(1);
    }
    else
    {
      MAM(m_I) = *(((U8 *)(*(MAM(m_SP)-1)))+4);
      MAM(m_IP) += 1+4;
    }
}


/* Format:       jmp_neq_indexes_mixed (U8)width (U8)mask (U32)addr
Size:         1+1+1+4

This instruction works like 'jmp_neq_indexes_large',  except that the indexes are to be
found in the 'width' least significant bits of the two words on top of stack.

If the indexes are distinct, false is put in R, and a jump to addr is performed.

Otherwise, the  mask enables to know  if the alternative is  small or mixed.   If it is
small, false is put in R and a jmp to addr is performed

If it is mixed, the indices must be erased (in that case, we may erase 2 bits), and the
index must be put in I. */
ci_decl(jmp_neq_indexes_mixed)
{
  trace
    U32 index_mask = (1<<get8(1))-1;

  if (((*(MAM(m_SP)-1))&index_mask) != ((*(MAM(m_SP)-2))&index_mask))  /* distinct indices */
  {
    MAM(m_R) = 0; /* false */
    MAM(m_IP) = (U8 *)get32(3);  /* jmp to addr */
  }
  else
  {
    MAM(m_I) = ((*(MAM(m_SP)-1))&index_mask);         /* get the index before
                                                         erasing it */

    /* determine if alternative is small or mixed */
    if ((1<<MAM(m_I))&get8(2))
    {
      /* mixed */
      *(MAM(m_SP)-1) &= pointer_mask;
      *(MAM(m_SP)-2) &= pointer_mask;
      MAM(m_IP) += 1+1+1+4;
    }
    else
    {
      /* small */
      MAM(m_R) = 0;
      MAM(m_IP) = (U8 *)get32(3);
    }
  }
}


/* Format:      jmp_neq_string (U32)addr
Size:        1+4

This instruction compares the strings pointed  to by the pointers pointed to by *(SP-1)
and *(SP-2).  The jump to addr is performed if they differ, and 0 (false) put in R. */
ci_decl(jmp_neq_string)
{
  trace
    if (strcmp((*((char **)(*(MAM(m_SP)-1))))+4,(*((char **)(*(MAM(m_SP)-2))))+4))
      /* strings differ */
    {
      MAM(m_R) = 0;
      MAM(m_IP) = (U8 *)get32(1);
    }
    else
      MAM(m_IP) += 1+4;
}

ci_decl(jmp_neq_byte_array)
{
  trace
    /* get the two byte arrays */
    U32 ba1 = *((U32 *)(*(MAM(m_SP)-1)));
  U32 ba2 = *((U32 *)(*(MAM(m_SP)-2)));

  /* get the sizes of the two byte arrays */
  U32 size1 = ((U32 *)(ba1))[1];
  U32 size2 = ((U32 *)(ba2))[1];

  if (size1 != size2)
  {
    MAM(m_R) = 0;
    MAM(m_IP) = (U8 *)get32(1);
  }
  else
  {
    U8 *a1 = ((U8 *)ba1)+8;
    U8 *a2 = ((U8 *)ba2)+8;


    /*MHMH*/
#ifdef use_memcmp
    if(memcmp(a1, a2, size1))
    { /* differs */
      MAM(m_R) = 0;
      MAM(m_IP) = (U8 *)get32(1);
    }
    else
    { /* equals */
      MAM(m_IP) += 1+4;
    }
#else
    U32 i;
    for (i = 0; i < size1; i++)
    {
      //fprintf(stdout,"\njmp_neq_byte_array: a1[%d]=%d a2[%d]=%d",i,a1[i],i,a2[i]); fflush(stdout);
      if (a1[i] != a2[i])
      {
        MAM(m_R) = 0;
        MAM(m_IP) = (U8 *)get32(1);
        //fprintf(stdout,"MAM(m_IP) = %d\n",relative_IP(MAM(m_IP))); fflush(stdout);
        return;
      }
    }
    /* otherwise byte arrays are identical */
    MAM(m_IP) += 1+4;
#endif
  }
}


ci_decl(jmp_neq_int)
{
  trace

    /* get the two integers */
    U32 int1 = *((U32 *)(*(MAM(m_SP)-1)));
  U32 int2 = *((U32 *)(*(MAM(m_SP)-2)));

  if (int1 & 1)  /* int1 is small */
  {
    if (int1 == int2)    /* this also compares signs (bit 1) */
    {
      MAM(m_R) = 1;                   /* true */
      MAM(m_IP) += 1+4;               /* don't jump */
    }
    else
    {
      MAM(m_R) = 0;                   /* false */
      MAM(m_IP) = (U8 *)get32(1);     /* jump */
    }
  }
  else    /* int1 is big */
  {
    if (int2 & 1)
    {
      MAM(m_R) = 0;                   /* false */
      MAM(m_IP) = (U8 *)get32(1);     /* jump */
    }
    else  /* int1 and int2 are big */
    {
      /* get the number of bigits in the two nats */
      U32 size1 = ((U32 *)(int1&pointer_mask))[1];
      U32 size2 = ((U32 *)(int2&pointer_mask))[1];

      assert(((U32 *)(int1&pointer_mask))[2]);   /* check that there are in normal form */
      assert(((U32 *)(int2&pointer_mask))[2]);

      if (size1 != size2)
      {
        MAM(m_R) = 0;                   /* false */
        MAM(m_IP) = (U8 *)get32(1);     /* jump */
      }
      else
      {
        U32 pint1 = int1&pointer_mask;
        U32 pint2 = int2&pointer_mask;

        /*MHMH*/
#ifdef use_memcmp
        if(memcmp(((U32*)pint1)+2, ((U32*)pint2)+2, size1*sizeof(U32)))
        { /* differs */
          MAM(m_R) = 0;                   /* false */
          MAM(m_IP) = (U8 *)get32(1);     /* jump */
        }
        else
        { /* equals */
          MAM(m_R) = 1;                   /* true */
          MAM(m_IP) += 1+4;               /* don't jump */
        }
#else
        U32 i = 2;
        while (i < size1 + 2)
        {
          if ( ((U32 *)pint1)[i] != ((U32 *)pint2)[i] ) break;
          i++;
        }
        if (i == size1 + 2)
        {
          MAM(m_R) = 1;                   /* true */
          MAM(m_IP) += 1+4;               /* don't jump */
        }
        else
        {
          MAM(m_R) = 0;                   /* false */
          MAM(m_IP) = (U8 *)get32(1);     /* jump */
        }
#endif
      }
    }
  }
}


ci_decl(eq_int)
{
  trace

    /* get the two integers */
    U32 int1 = *(MAM(m_SP)-1);
  U32 int2 = *(MAM(m_SP)-2);

  if (int1 & 1)  /* int1 is small */
  {
    if (int1 == int2)
    {
      MAM(m_R) = 1;                   /* true */
    }
    else
    {
      MAM(m_R) = 0;                   /* false */
    }
  }
  else    /* int1 is big */
  {
    if (int2 & 1)
    {
      MAM(m_R) = 0;                   /* false */
    }
    else  /* int1 and int2 are big */
    {
      U32 pint1 = int1&pointer_mask;
      U32 pint2 = int2&pointer_mask;

      /* get the number of bigits in the two integers */
      U32 size1 = ((U32 *)pint1)[1];
      U32 size2 = ((U32 *)pint2)[1];

      assert(((U32 *)pint1)[2]);   /* check that there are in normal form */
      assert(((U32 *)pint2)[2]);

      if (size1 != size2)
      {
        MAM(m_R) = 0;                   /* false */
      }
      else
      {
        /*MHMH*/
#ifdef use_memcmp
        if(memcmp(((U32*)pint1)+2, ((U32*)pint2)+2, (size1+2)*sizeof(U32)))
        { /* differs */
          MAM(m_R) = 0;                   /* false */
        }
        else
        { /* equals */
          MAM(m_R) = 1;                   /* true */
        }
#else
        U32 i = 2;
        while (i < size1 + 2)
        {
          if ( ((U32 *)pint1)[i] != ((U32 *)pint2)[i] ) break;
          i++;
        }
        if (i == size1 + 2)
        {
          MAM(m_R) = 1;                   /* true */
        }
        else
        {
          MAM(m_R) = 0;                   /* false */
        }
#endif
      }
    }
  }
  MAM(m_IP) += 1;
}


/* Format:      new_locvar
Size:        1

This instruction  constructs a new  local variable, with  initial value the  content of
MAM(m_R). The new (pointer to) local variable is stored in MAM(m_R).

A local variable is a data segment with:

at offset 0:        reference counter
at offset 4:        value of variable
 */
ci_decl(new_locvar)
{
  trace
    U32 aux;
  vm_alloc1(aux,2);
  *(((U32 *)aux)+1) = MAM(m_R);     /* store the value */
  MAM(m_R) = aux;
  MAM(m_IP) += 1;
}


/* Format:      read_locvar
Size:        1

This instruction gets a local variable on top  of stack, and puts its value in MAM(m_R).  No
copy is performed.   If a copy is  needed the compiler puts a  'copy' instruction after
this one. The local variable is unchanged. */
ci_decl(read_locvar)
{
  trace
    MAM(m_R) = *(((U32 *)(*(MAM(m_SP)-1)))+1);
  MAM(m_IP) += 1;
}


/* Format:      write_locvar
Size:        1

This instruction exchanges the content of  the local variable at *(MAM(m_SP)-1) to the value
in MAM(m_R). No garbage collection is needed. */
ci_decl(write_locvar)
{
  trace
    U32 aux = *(((U32 *)(*(MAM(m_SP)-1)))+1);
  *(((U32 *)(*(MAM(m_SP)-1)))+1) = MAM(m_R);
  MAM(m_R) = aux;
  MAM(m_IP) += 1;
}


/* Format:      word_64 n bytes cnt word1 word0 bytes     (bytes = alignment bytes)
Size:        1 + 1 + 3 +  4 + 4 +   4        = 17      */
ci_decl(word_64)
{
  trace
    MAM(m_R) = (U32)(MAM(m_IP)+2+get8(1));
  assert(((MAM(m_R))&3) == 0);        /* must be aligned on 0 mod 4 */
  assert(((U32 *)MAM(m_R))[0] == 0);  /* must be a permanent datum */
  MAM(m_IP) += 17;
}

ci_decl(word_64_push)
{
  trace
    MAM(m_R) = *(MAM(m_SP)++) = (U32)(MAM(m_IP)+2+get8(1));
  MAM(m_IP) += 17;
}

/* Format:      word_128 n bytes cnt word3 word2 word1 word0 bytes    (bytes = alignment bytes)
Size:        1 +  1 + 3 +   4 + 4 +   4 +   4 +   4        = 25      */
ci_decl(word_128)
{
  trace
    MAM(m_R) = (U32)(MAM(m_IP)+2+get8(1));
  assert(((MAM(m_R))&3) == 0);        /* must be aligned on 0 mod 4 */
  assert(((U32 *)MAM(m_R))[0] == 0);  /* must be a permanent datum */
  MAM(m_IP) += 25;
}
ci_decl(word_128_push)
{
  trace
    MAM(m_R) = *(MAM(m_SP)++) = (U32)(MAM(m_IP)+2+get8(1));
  MAM(m_IP) += 25;
}


/* Format:     load_int_small (U32)value
Size:       1+4

This instruction puts its operand (a small Int) into R.
 */
ci_decl(load_int_small)
{
  trace
    MAM(m_R) = get32(1);
  MAM(m_IP) += 1+4;
}


/* The same one but pushing the result into the stack */
ci_decl(load_int_small_push)
{
  trace
    MAM(m_R) = *(MAM(m_SP)++) = get32(1);
  MAM(m_IP) += 1+4;
}


/* Format:     load_int_big                         (1 byte)
               (U32)num_bigits             
               (U32)bigit 
               ... 
               (U32)bigit
               
        The above can be checked from compiler/vminstr.c
               
Size:      1 + 4 + 4*num_bigits

This instruction allocates a segment for a new non permanent Int.

 */
ci_decl(load_int_big)
{
  U32 num_bigits = get32(1);
  U32 k;
  trace

  vm_alloc1(MAM(m_R),2+num_bigits);           /* | counter | num | bigits ...  */
  ((U32 *)(MAM(m_R)))[1] = num_bigits;        /* put the number of bigits */
  for (k = 0; k < num_bigits; k++)            /* put the bigits */
    ((U32 *)(MAM(m_R)))[k+2] = get32(5+4*k);
  MAM(m_IP) += 5+(4*num_bigits);
}


/* The same one, but pushing the result onto the stack (not modifying MAM(m_R)) */
ci_decl(load_int_big_push)
{
  U32 X;    /* used instead of MAM(m_R) */
  U32 num_bigits = get32(1);
  U32 k;
  trace

  vm_alloc1(X,2+num_bigits);                  /* | counter | num | bigits ...  */
  ((U32 *)(X))[1] = num_bigits;               /* put the number of bigits */
  for (k = 0; k < num_bigits; k++)            /* put the bigits */
    ((U32 *)(X))[k+2] = get32(5+4*k);
  *(MAM(m_SP)++) = X;                         /* push the result on the stack */
  MAM(m_IP) += 5+(4*num_bigits);
}


/* Format:              load_float (U32) mantissa (U32) exponent
Size:                1+4+4

This instruction creates a positive floating  point number from the informations in the
operands.  The mantissa  is always positive and has  at most 'max_float_digits' decimal
digits (see grammar.y to  get the value). The exponent is signed  (it must be converted
to 'int').  The representation is constructed in the format which is convenient for the
hardware. */
ci_decl(load_float)
{
  trace
    double value = 0;
  U32 m = get32(1);
  int32_t e = getsigned32(1+4);

  /*    printf("m = %u, e = %d\n",m,e);  */

  /* A floating  point number  in the virtual  machine is  a pointer to  a segment
     which is organized as follows:

     offset 0: counter     (4 bytes)
     offset 4: value       (8 bytes)

     Since the value is a double it takes 8 bytes. Hence, we must
     allocate 3 words. */

  vm_alloc1(MAM(m_R),3);

  value = m;
  if (e > 0)
  {
    while (e > 0) { value *= 10; e--; }
  }
  else if (e < 0)
  {
    while (e < 0) { value /= 10; e++; }
  }

  /* store the value in the data segment */
  *((double *)(((U8 *)MAM(m_R))+4)) = value;
  MAM(m_IP) += 1+4+4;
}


/* Before version 1.13:

Format:      string (U32)length (U32)counter (U8)...(U8) (U8)0
Size:        1+4+4+length+1

This instruction contains a character string.  The first (U32) operand is the length of
the string  (the trailing 0 not  included). The second  operand is a counter  which has
value 0. This value will always remain 0, which means that the string is permanent. The
string itself follows this operand, and is delimited by a 0.

The action of the instruction is to put the address of the null counter into MAM(m_R).

Since version 1.13:

Format:      string (U32)length (U8)...(U8)         (no trailing 0)
Size:        1+4+length

The instruction string allocates a segment and copies the string into it. Since version
1.13 there are no more permanent strings.

 */
ci_decl(string)
{
  trace
    U32 k;
  U32 len = get32(1);

  /* the two lines below replaced since version 1.13 */
  //MAM(m_R) = (U32)(MAM(m_IP)+1+4);  /* address of null counter */
  //assert(*((U32 *)(MAM(m_R))) == 0);
  vm_alloc1(MAM(m_R),byte_size_to_word_size(4+len+1));  /* counter + string + trailing 0 */
  for (k = 0; k < len; k++) (((U8 *)(MAM(m_R)))+4)[k] = (((U8 *)(MAM(m_IP)))+5)[k];
  (((U8 *)(MAM(m_R)))+4)[k] = 0;

  /* the line below replaced since version 1.13 */
  //MAM(m_IP) += 1+4+4+get32(1)+1;
  MAM(m_IP) += 1+4+get32(1);
}


/* The same one but pushing the result onto the stack */
ci_decl(string_push)
{
  trace
    U32 k;
  U32 len = get32(1);

  // the two lines below replaced since version 1.13 */
  //MAM(m_R) = *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1+4);  /* address of null counter */
  //MAM(m_IP) += 1+4+4+get32(1)+1;
  vm_alloc1(MAM(m_R),byte_size_to_word_size(4+len+1));
  for (k = 0; k < len; k++) (((U8 *)(MAM(m_R)))+4)[k] = (((U8 *)(MAM(m_IP)))+5)[k];
  (((U8 *)(MAM(m_R)))+4)[k] = 0;
  *(MAM(m_SP)++) = MAM(m_R);
  MAM(m_IP) += 1+4+len;
}

ci_decl(byte_array)
{
  trace
    int k;
  int len = get32(1);

  vm_alloc1(MAM(m_R),byte_size_to_word_size(4+4+len));
  for (k = 0; k < len; k++) (((U8 *)(MAM(m_R)))+8)[k] = (((U8 *)(MAM(m_IP)))+5)[k];
  ((U32 *)(MAM(m_R)))[1] = len;
  MAM(m_IP) += 1+4+len;
}


/* Format:          dec3 (U32)addr
Size:            1+4

Decrement word at *(MAM(m_SP)-3) and jump to address if result non zero. */
ci_decl(dec3)
{
  trace
    if (--(*(MAM(m_SP)-3)))
      MAM(m_IP) = (U8 *)get32(1);
    else
      MAM(m_IP) += 1+4;
}


/* Format:             alt_number_direct (U8)index_width
Size:               1+1

Puts the index of the datum into MAM(m_R). This is for small and mixed types. */
ci_decl(alt_number_direct)
{
  trace
    MAM(m_R) = (*(MAM(m_SP)-1))&((1<<get8(1))-1);
  MAM(m_IP) += 1+1;
}


/* Format:             alt_number_indirect
Size:               1

The same one for large types. */
ci_decl(alt_number_indirect)
{
  trace
    MAM(m_R) = (U32)(((U8 *)(*(MAM(m_SP)-1)))[4]);
  MAM(m_IP) += 1;
}


/* Format:        start (U8)depth (U32)addr
Size:          6

This instruction  starts a new virtual machine.  The 'depth' argument is  the number of
items which should be  copied from the top of the stack of  the current machine, to the
stack of  the new machine.   These items are  just words. There  is no virtual  copy to
perform. They have been already done by the instructions just before 'start'.

'addr' is the address  to which the current machine should jump  after starting the new
machine.   The   new  machine   itself  executes  the   code  following   this  'start'
instruction.

 */
ci_decl(start)
{
  trace
    U32 *new_stack = NULL;
  U8 d = get8(1);
  U8 i;

  AnubisProcess * newProcess;
  newProcess = TheAnubisProcessList->
    CreateAnubisProcess(MAM(m_IP)+6,         /* new machine starting point (6 is the size of the 'start' instruction) */
        MAM(m_priority),                     /* priority level of current process */
        MAM(m_allocator));

  //printf("[%d] Creating new process. Starting %d. PID = %d\n", MAM(m_pid), relative_IP(MAM(m_IP)+6), newProcess->GetPid());
  if (!newProcess)
    /* cannot start a new machine yet, retry at next run */
  {
    MAM(m_steps) = 0;
    return;
  }

  /* the new machine has been started */
#ifndef normal_machine
#undef MAM(m_SP_begin)
#endif
  new_stack = newProcess->GetSPBegin();
#ifndef normal_machine
#define MAM(m_SP_begin) (MAM(m_SP_begin))
#endif
  new_stack[0] = 0;             /* last return */
  for (i = d; i >= 1; i--)
    new_stack[d-i+1] = *(MAM(m_SP)-i);

#ifndef normal_machine
#undef MAM(m_SP)
#endif
  newProcess->SetSP(new_stack + d + 1);
#ifndef normal_machine
#define MAM(m_SP) (MAM(m_SP))
#endif
  MAM(m_IP) = (U8 *)get32(2);
}


/* Format:        startp (U8)depth (U32)addr
Size:          6

This instruction  starts a new virtual machine.  The 'depth' argument is  the number of
items which should be  copied from the top of the stack of  the current machine, to the
stack of  the new machine.   These items are  just words. There  is no virtual  copy to
perform. They have been already done by the instructions just before 'start'.

The priority level (a Word8) is in R. 

'addr' is the address  to which the current machine should jump  after starting the new
machine.   The   new  machine   itself  executes  the   code  following   this  'start'
instruction.

 */
ci_decl(startp)
{
  trace
    U32 *new_stack = NULL;
  U8 d = get8(1);
  U8 i;

  AnubisProcess * newProcess;
  newProcess = TheAnubisProcessList->
    CreateAnubisProcess(MAM(m_IP)+6,         /* new machine starting point (6 is the size of the 'start' instruction) */
        MAM(m_R),                            /* priority level of new process */
        MAM(m_allocator));

  //printf("[%d] Creating new process. Starting %d. PID = %d\n", MAM(m_pid), relative_IP(MAM(m_IP)+6), newProcess->GetPid());
  if (!newProcess)
    /* cannot start a new machine yet, retry at next run */
  {
    MAM(m_steps) = 0;
    return;
  }

  /* the new machine has been started */
#ifndef normal_machine
#undef MAM(m_SP_begin)
#endif
  new_stack = newProcess->GetSPBegin();
#ifndef normal_machine
#define MAM(m_SP_begin) (MAM(m_SP_begin))
#endif
  new_stack[0] = 0;             /* last return */
  for (i = d; i >= 1; i--)
    new_stack[d-i+1] = *(MAM(m_SP)-i);

#ifndef normal_machine
#undef MAM(m_SP)
#endif
  newProcess->SetSP(new_stack + d + 1);
#ifndef normal_machine
#define MAM(m_SP) (MAM(m_SP))
#endif
  MAM(m_IP) = (U8 *)get32(2);
}


/* Format:       finish
Size:         1

This instruction stops execution of the virtual machine */
ci_decl(finish)
{
  trace
    //printf("Machine %d has executed 'finished'.\n",(int)MAM(m_pid));
    assert((int)(MAM(m_SP)-MAM(m_SP_begin)) == 2);

  /* The stack is freed in 'AnubisProcess.cpp' in destructor '~AnubisProcess'. */

  /*
     if (MAM(m_serial_buf) != NULL) LOGERROR("*********************** Machine %d has 'finish' non NULL serialization buffer.\n",
     (int)MAM(m_pid));
   */

  MAM(m_status) = finished;
  MAM(m_steps) = 0;
}


/* Format:        copy_stack_ptr (U8)depth
Size:          1+1

This instruction makes a virtual copy  of the indirect datum whose manipulation word is
at depth 'depth' in the stack. The datum is copied only if not permanent. */
ci_decl(copy_stack_ptr)
{
  trace
    U32 *ptr = (U32 *)(*(MAM(m_SP)-(1+get8(1))));
  if (ptr && *ptr != 0) (*ptr)++;
  MAM(m_IP) += 1+1;
}


/* Format:        copy_stack_function (U8)depth
Size:          1+1

This is similar to copy_stack_ptr, but applies to functions. */
ci_decl(copy_stack_function)
{
  trace
    U32 f = (*(MAM(m_SP)-(1+get8(1))));
  if (f&1)
  { /* top level function */
    vcopy_module_ref((U8 *)f,relative_IP(MAM(m_IP)));
  }
  else
  { /* closure function */
    assert(f);
    if (*((U32 *)f) != 0) (*((U32 *)f))++;
  }
  MAM(m_IP) += 1+1;
}


/* Format:        copy_stack_int (U8)depth
Size:          1+1

This is similar to copy_stack_ptr, but applies to integers. */
ci_decl(copy_stack_int)
{
  trace
    U32 n = (*(MAM(m_SP)-(1+get8(1))));
  if (!(n&1))
  {
    assert(n);
    if (*((U32 *)(n&pointer_mask)) != 0) (*((U32 *)(n&pointer_mask)))++;
  }
  MAM(m_IP) += 1+1;
}


/* Format:        copy_stack_mixed (U8)depth (U8)mask
Size:          1+1+1

Same  as the  previous  one,  except that  the  virtual copy  is  done  only for  mixed
alternatives. */
ci_decl(copy_stack_mixed)
{
  trace
    U32 w = (*(MAM(m_SP)-(1+get8(1))));
  if ((1<<(w&3))&get8(2))
  {
    if (*((U32 *)(w&pointer_mask))) (*((U32 *)(w&pointer_mask)))++;
  }
  MAM(m_IP) += 1+1+1;
}


/* Format:      load_word32 (U32)n
Size:        1+4

This instruction puts its unique operand (an integer) into R. */
ci_decl(load_word32)
{
  trace
    MAM(m_R) = get32(1);
  MAM(m_IP) += 1+4;
}


/* Format:          success (U8)bit_width
Size:            1+1

This instruction expects a datum 'd' in MAM(m_R).   The type of this datum has the given bit
width. The instruction must replace 'd' by 'success(d)' in MAM(m_R). */
ci_decl(success)
{
  trace
    if (get8(1) < 32)
    {
      MAM(m_R) = (MAM(m_R)<<1)|1;
    }
    else
    {
      U32 aux;
      vm_alloc1(aux,2);
      *(((U32 *)aux)+1) = MAM(m_R);
      MAM(m_R) = aux|1;     /* glue mixed index for 'success' */
    }
  MAM(m_IP) += 1+1;
}


/* Format:          serialize (U32)addr
Size:            1+4

This instruction asks for the serialization of the datum at *(MAM(m_SP)-1).  The 'addr'
operand is the address of the pseudo-code for the type of this datum.

This instruction  works like a call  except that it  must push the return  address just
under  the  datum to  be  serialized.   It also  changes  the  current  'work sort'  to
'serializing'. */
ci_decl(serialize)
{
  trace
    //check_stack(1);
    /* get a serialization buffer */
    if ((U32)(MAM(m_serial_buf)) == 0)
    {
      U32 aux;
      vm_alloc1(aux,serial_words_increment);
      MAM(m_serial_buf) = (U8 *)aux;
    }

  assert(((U32 *)(MAM(m_serial_buf)))[0] == 1);
  MAM(m_serial_size) = serial_words_increment*4;
  MAM(m_serial_next) = 4+4;               /* where to put the first byte */

  *MAM(m_SP) = *(MAM(m_SP)-1);                 /* push the datum one slot further */
  *(MAM(m_SP)-1) = (U32)(MAM(m_IP)+1+4);       /* put the return address */
  MAM(m_SP)++;                            /* adjust stack pointer */
  MAM(m_work_sort) = serializing;         /* change work sort */
  MAM(m_IP) = (U8 *)get32(1);             /* jump to pseudo-code */
}


/* Format:           unserialize (U32)addr
Size:             1+4

See the discussion in 'compile.c'. This instruction expects the following state:

MAM(m_R)            stack          serial_buf    unserial_failed
b                    ...           (empty)           (empty)

where 's' is the byte array to unserialize. The instruction must:

1. put (the address of) 'b' into the 'serial_buf' register, and
initialize related registers (serial_size and serial_next),
2. put 0 in the flag 'unserial_failed'
3. push a return address 'r',
4. put the machine in the state 'unserializing',
5. jump to addr

Hence, just after 'unserialize' has executed, we have:

MAM(m_R)            stack          serial_buf    unserial_failed
(empty)         r ...              b               0

 */
ci_decl(unserialize)
{
  trace
    /* put the byte array to unserialize into MAM(m_serial_buf) */
    assert((U32)(MAM(m_serial_buf)) == 0);   /* which should be empty
                                                (see revert_to_computing) */
  MAM(m_serial_buf) = (U8 *)MAM(m_R);       /* put 'b' */
  MAM(m_serial_size) = 4+4+(*(((U32 *)(MAM(m_serial_buf)))+1));
  /* get total size i.e:   4 bytes for the conter
     4 bytes for the number n of bytes
     n bytes for the bytes. */
  MAM(m_serial_next) = 4+4;    /* ignore counter and size */
  MAM(m_unserial_failed) = 0;
  /* when MAM(m_serial_next) is equal to the above, there is no
     more data to read. */

  *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1+4);       /* push the return address */
  MAM(m_work_sort) = unserializing;       /* change work sort */
  MAM(m_IP) = (U8 *)get32(1);             /* jump to pseudo-code */
}


ci_decl(nop)
{
  trace
    /* do nothing but advance by one byte */
    MAM(m_IP)++;
}


/* Those which are not yet implemented or never executed */

ci_decl(odd_align)     /* this one is required but never executed */
{
  trace
    my_exit(8);
}


ci_decl(dummy)
{
  trace
}


/* Format:     begin_op
Size:       1+4+20+1

Used by profiling to mark the begin of  a function.  The data are composed by a 4 bytes
length PC value for the function, followed by a 20 characters length function name, and
a terminating null char.
 */
ci_decl(begin_op)
{
  trace
    U32 offset = get32(1);
  const char *name = (const char *)(MAM(m_IP) + 5);
  //   printf("Offset %d | fn = %s\n", offset, name);
  FunctionCall * parent = MAM(m_current_function);
  if (parent && parent->IsTerminal())
  {
    // nothing
  }
  else
  {
    FunctionSummary * fSummary = AnubisProcess::GetFunction(name, offset, true);
    MAM(m_current_function) = new FunctionCall(fSummary, MAM(m_current_function));
    MAM(m_current_function)->SetStartTime(system_time());
  }
  MAM(m_IP) += 26;
}

/* Format:     end_op
Size:       1+4+1

Used by  profiling to  mark the end  of a  function.  Data contains  the offset  of the
function beginning followed  by a single byte indicating if this  call is terminal call
or not.
 */


ci_decl(end_op)
{
  trace
    //  U32 offset = get32(1);
    bool isTerminal = get8(5) != 0;
  //  printf("  ---> Ending Offset %d | stack = %d\n", offset, stack);
  if(MAM(m_current_function))
  {
    FunctionCall * call = MAM(m_current_function);
    if(isTerminal)
    {
      call->TerminalCall();
    }
    else
    {
      //FunctionSummary * summary = call->Summary();
      MAM(m_current_function) = call->Parent();
      call->Return();
      delete call;
    }
  }
  MAM(m_IP) += 6;
}


#ifdef WITH_STATIC_MEMBERS
void (*((AnubisProcess::ci_ftable)[]))(AnubisProcess *) =
{
#define item(n) AnubisProcess::ci_##n,
  common_instructions_list
    normal_instructions_list
#undef item
#define item(n) AnubisProcess::ci_dummy,
    pseudo_instructions_list
#undef item
    ci_dummy
};

void (*((AnubisProcess::si_ftable)[]))(AnubisProcess *) =
{
#define item(n) AnubisProcess::serialize_##n,
  common_instructions_list
#undef item
#define item(n) AnubisProcess::serialize_dummy,
    normal_instructions_list
#undef item
#define item(n) AnubisProcess::serialize_##n,
    pseudo_instructions_list
#undef item
    serialize_dummy
};

void (*((AnubisProcess::ui_ftable)[]))(AnubisProcess *) =
{
#define item(n) AnubisProcess::ui_##n,
  common_instructions_list
#undef item
#define item(n) AnubisProcess::ui_dummy,
    normal_instructions_list
#undef item
#define item(n) AnubisProcess::ui_##n,
    pseudo_instructions_list
#undef item
    ui_dummy
};

#else
#endif

#ifdef debug_vm
U32 default_security_value = 0xffffffff;
U8* common_code_begin;
U8* current_IP;
#endif


/*** RunMachine (the function by which virtual machines work) ***/

/* This function is independent */
int AnubisProcess::RunMachine(int steps)
{
#ifdef WITH_STATIC_MEMBERS
#define CARG (AnubisProcess *)this
#define this_one this
#else
#define CARG
#define this_one
#endif
  int steps_done = 0;
  //printf("Running machine %d at %d\n",(int)m_pid,(int)(m_IP-m_code_begin));
  m_steps = steps;

  while (m_steps > 0)
  {

    //printf("steps: %ld IP: %ld\n",m_steps,MAM(m_IP)-MAM(m_code_begin));
    steps_done++;
#ifdef WATCH_CODE
    assert(MAM(m_IP) >= MAM(m_code_begin) && MAM(m_IP) < MAM(m_code_end));

    U8* prev_IP = MAM(m_IP);
#endif
#ifdef debug_vm
    current_IP = MAM(m_IP);
#endif
    switch(m_work_sort)
    {
      case computing:
        //printf("\n(instr %d at IP = %d)",*MAM(m_IP),MAM(m_IP)-MAM(m_code_begin));
        (ci_ftable[*(MAM(m_IP))])(CARG);
        break;

      case serializing:
        (si_ftable[*(MAM(m_IP))])(CARG);
        break;

      case unserializing:
        (ui_ftable[*(MAM(m_IP))])(CARG);
        break;

      default:
        assert(0);
    }
#ifdef WATCH_CODE
    compare_watched_code(prev_IP-MAM(m_code_begin));
#endif
    m_steps--;
  }
#undef CARG
#undef this_one
  return steps_done;
}