literal strings are no more pemanent

Alain Prouté
1 parent 54a181da
Showing 8 changed files with 428 additions and 684 deletions Show diff stats
anubis_dev/compiler/src/vminstr.c
anubis_dev/include/bytecode.h
anubis_dev/vm/src/anbexec.cpp
anubis_dev/vm/src/dynamic_module.cpp
anubis_dev/vm/src/secondary_module.anubis
anubis_dev/vm/src/vm.cpp
anubis_dev/vm/src/vm.h
anubis_dev/vm/src/vmtools.cpp
@@ -329,11 +329,6 @@ int instruction_size(Expr instr, int offset)
       case micro_peek_copy_push_mixed:
  return 10;
-#if 0
-      case load_adm:
-        return 9;    /* 1 + 4 + 4 */ 
-#endif 
-   
       case _switch:
       case type_large_switch:
  return 2 + 4*length(cdr(instr));  
@@ -376,7 +371,8 @@ int instruction_size(Expr instr, int offset)
       case string:
       case string_push:
- return 1+4+4+strlen(string_content(compiled_strings[integer_value(cdr(instr))].string))+1; 
+      /* new format since version 1.13 (see vm/vm.cpp) */ 
+ return 1+4+strlen(string_content(compiled_strings[integer_value(cdr(instr))].string)); 
       case program:
         {
@@ -971,11 +967,13 @@ void translate_instruction(U8 *code_addr,
         *(((U32 *)(*ptr))) = len = 
           strlen(string_content(compiled_strings[integer_value(cdr(instr))].string));
         *ptr += sizeof(U32); 
-        *(((U32 *)(*ptr))) = 0; /* null counter => permanent string */
-        *ptr += sizeof(U32); 
+        /* the two lines below eliminated since version 1.13 */ 
+        //*(((U32 *)(*ptr))) = 0; /* null counter => permanent string */
+        //*ptr += sizeof(U32); 
         for (i = 0; i < len; i++)
           *((*ptr)++) = 172^((string_content(compiled_strings[integer_value(cdr(instr))].string))[i]);
-        *((*ptr)++) = 172; 
+        /* the line below eliminated since version 1.13 */
+        //*((*ptr)++) = 172; 
         break; 
       case program:     /* (program instruction ... instruction) */ 
@@ -1682,22 +1680,6 @@ void translate_instruction(U8 *code_addr,
         }
         break;    
-#if 0   
-      case load_adm:    /* (load_adm module_name, type_description) */ 
-        {
-          *((*ptr)++) = i_load_adm; 
-          instr = cdr(instr); 
-          *(((U32 *)(*ptr))) = length(instr);
-          *ptr += sizeof(U32);
-          while(consp(instr))
-            {
-              *((*ptr)++) = (U8)(integer_value(car(instr)));
-              instr = cdr(instr); 
-            }
-        }
-        break; 
-#endif 
-
    case begin_op:
         *((*ptr)++) = i_begin_op; 
     {
@@ -222,7 +222,6 @@ typedef enum
   item(get_mvar_monitors)\
   item(xchg_mvv)\
   item(get_mvv)\
-  item(load_adm)\
   item(load_int_small)\
   item(load_int_big)\
   item(begin_op)\
@@ -244,7 +244,7 @@ U32 read32(FILE *fp)
 void syntax(void)
 {
   LOGINFO("anbexec version %d.%d.%d.%d\n"
-         "   (Build date: %s )\n"
+         "   (Build date: %s %s)\n"
 #ifdef _WITH_SSL_
          "   (%s)\n"
 #endif
@@ -272,7 +272,7 @@ void syntax(void)
 				 "     --csv_sep:<sep>      defines which separator to use when outputing profiling\n"
 				 "                            data as CSV. Default is ',' (comma).\n"
 				 "     --perf               activate performance computing (load average)\n"
-          , maj_version, min_version, rel_version, build_version, __DATE__,
+          , maj_version, min_version, rel_version, build_version, __DATE__,__TIME__,
 #ifdef _WITH_SSL_
 					OPENSSL_VERSION_TEXT, 
 #endif
@@ -424,7 +424,7 @@ int load_module(struct Exec_Mod_struct *mod,
   /* code segment must be aligned on 0 mod 4 */ 
   assert((((U32)code)&3) == 0); 
-  /* make the code apermanent byte array */ 
+  /* make the code a permanent byte array */ 
   ((U32 *)code)[0] = 0; 
   /* put the size at its place */ 
   ((U32 *)code)[1] = code_size; 
@@ -414,31 +414,30 @@ U32                          number_of_module_slots = 0;        /* total number 
    /* Note: the initial primary module is also recorded in this array, and counted */ 
    /* Resizing the modules array depending on the number of modules. 
-      We arrange so that there is always at least one free slot. Hence, we can 
-      store a new module, without worrying about resizing the modules array. 
-      Of course, after this operation we must eventually try to resize it. 
-      We also maybe resize it down when a module is collected. 
       The precise policy is the following: 
       - When anbexec starts, an array of 'module_slot_steps' slots is allocated. 
-      - when a module is added to the array, it is inserted so that the 'module_begin'
-        fields remain in increasing order, and the array is resized if full. 
+      - when a module is added to the array, it is inserted so that the 'byte_code'
+        fields remain in increasing order (and the array is previously resized if full). 
       - when a module is discarded, the modules above it are shifted down in the array, 
         so that the modules are all at the beginning of the array without any hole between them. 
         The number of modules currently present in the array is always 'number_of_modules'. 
-      'resize_module_array' is called when anbexec starts, so that there is at least one free
-      slot at the beginning. 
+      'resize_module_array' is called when anbexec starts in order to put the primary module
+      in the array .  
    */ 
 int  /* 0 = out of memory, 1 = ok */   
    resize_modules_array(void)
 {
+
+  printf("resize_modules_array: modules: %\ld slots: %ld\n",number_of_modules,number_of_module_slots); fflush(stdout); 
+
   /**/
   if (modules == NULL)
   {
-    printf("initial allocation of modules array.\n"); fflush(stdout); 
+    printf("Initial allocation of modules array.\n"); fflush(stdout); 
     U32 seg = (U32)malloc(sizeof(struct Exec_Mod_struct)*module_slots_step); 
     if ((U32 *)seg == NULL) return 0; 
     modules = (struct Exec_Mod_struct *)seg; 
@@ -448,7 +447,7 @@ int  /* 0 = out of memory, 1 = ok */
   if (number_of_modules == number_of_module_slots)
   {
     /* the array needs to be enlarged */
-    printf("enlarging modules array.\n"); fflush(stdout); 
+    printf("Enlarging modules array.\n"); fflush(stdout); 
     U32 seg = (U32)realloc((void *)modules,
               sizeof(struct Exec_Mod_struct)*(number_of_module_slots+module_slots_step)); 
     if ((U32 *)seg == NULL) return 0;    /* enlargement failed */
@@ -546,18 +545,17 @@ int find_module_index(U8* reference)
               'find_module_index' defined above.*/ 
-   /*** Adding a module to the array. *****************************************************/
-   
-void check_module_order()
+void check_module_order()   /* several verifications on the modules array */ 
 {
   U32 k; 
   for (k = 0; k < number_of_modules; k++)
   {
-    printf("index %lu module address: %lu (cnt = %ld)\n",
+    printf("index %lu module address: %lu (cnt = %ld) %s\n",
            k,
            (U32)(modules[k].byte_code),
-           ((U32 *)(modules[k].byte_code))[0]); fflush(stdout); 
+           ((U32 *)(modules[k].byte_code))[0],
+           ((modules[k].flags)&mf_secondary_adm) ? "" : "(primary module)"); fflush(stdout); 
   }
   for (k = 0; k < number_of_modules - 1; k++)
@@ -567,6 +565,8 @@ void check_module_order()
 }   
+   /*** Adding a module to the array. *****************************************************/
+   
 int  /* 0 = out of memory, 1 = ok */  
    add_module(  U32 flags, 
                 U8* byte_code,
@@ -576,6 +576,26 @@ int  /* 0 = out of memory, 1 = ok */
 {
   U32 index = find_module_index(byte_code); 
   U32 k; 
+
+  /* Resize the array if needed.
+  
+  Why we must do it before adding the module: 
+  
+  - the first reason is that the array may be full. 
+  
+  - but there is another reason. When I wrote this the first time I arranged so that
+    the modules array always has at least one free slot, so that it was possible
+    to add the module and enlarge the array only after this operation. But actually, 
+    it does not work because the syscall 'relocate_code' (in syscall.cpp) is where we
+    add the new relocated module to the array (in other words, it calls 'add_module'), 
+    and uses the 'duc_non_empty' register for knowing if the module has already
+    been relocated when it comes back after having given up because 'add_module'
+    returned 0 the first time. The second time, it calls 'add_module' again. 
+    Hence, it is necessary that 'add_module' does not add the module if the array
+    cannot be enlarged. Otherwise, the module could be recorded several times. 
+  
+  */ 
+  if (!resize_modules_array()) return 0; 
   printf("add_module: index found: %lu\n",index); fflush(stdout);
@@ -610,9 +630,7 @@ int  /* 0 = out of memory, 1 = ok */
   number_of_modules++; 
   check_module_order();   
-    
-  /* resize the array if needed */ 
-  return resize_modules_array(); 
+  return 1; 
 }
@@ -626,7 +644,7 @@ void
   if (show_module_loading) printf("Unloading module %d\n",index); 
   /* free the module segment */
-  allocator->FreeDataSegment((U32 *)((modules[index].byte_code)-8)); 
+  allocator->FreeDataSegment((U32 *)((modules[index].byte_code))); 
   number_of_modules--; 
   /* shift next modules one slot down */
@@ -645,7 +663,7 @@ void
 //          sizeof(struct Exec_Mod_struct)*(number_of_modules-index));   /* number of bytes to be moved */ 
   /* if possible reduce the size of the modules array */
-  resize_modules_array(); 
+  resize_modules_array();
 }
@@ -653,9 +671,19 @@ void
 void vcopy_module_ref(U8 *ref)
 {
   int index = find_module_index(ref); 
+  return; 
+  if ((modules[index].flags)&mf_secondary_adm)            /* don't do anything for primary module */ 
+  {
+    (*((U32 *)((modules[index].byte_code))))++;         /* increment counter of module */ 
+  }  
+}
+
+void multiple_vcopy_module_ref(U8 *ref,U32 n)             /* in case we need to make n virtual copies */ 
+{
+  int index = find_module_index(ref); 
   if ((modules[index].flags)&mf_secondary_adm)            /* don't do anything for primary module */ 
   {
-    (*((U32 *)((modules[index].byte_code)-8)))++;         /* increment counter of module */ 
+    (*((U32 *)((modules[index].byte_code)))) += n;   
   }  
 }
@@ -663,12 +691,14 @@ void vcopy_module_ref(U8 *ref)
 void vdelete_module_ref(U8 *ref, AnubisAllocator *allocator)
 {
   int index = find_module_index(ref); 
+  return; 
   if ((modules[index].flags)&mf_secondary_adm)            /* don't do anything for primary module */ 
   {
-    (*((U32 *)((modules[index].byte_code)-8)))--;         /* decrement counter of module */ 
-    if (!(*((U32 *)((modules[index].byte_code)-8))))      /* if down to 0 */
+    if (*((U32 *)((modules[index].byte_code))))           /* beware of permanent modules */
+       (*((U32 *)((modules[index].byte_code))))--;         /* decrement counter of module */ 
+    if (!(*((U32 *)((modules[index].byte_code)))))      /* if down to 0 */
     {
-      remove_module(index, allocator); 
+      //remove_module(index, allocator); 
     }
   }  
 }
@@ -24,7 +24,7 @@
 global define String 
   secondary_module
     = 
-  "Bla bla blo.\n". 
+  "Bla bla blu.\n". 
@@ -5,8 +5,25 @@
    **************************************************************************************/
+
+
+   /*
+   
+   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 */ 
+   
+   Serializing/unserializing stuff is in 'serialize.cpp'. 
+   
+   */
+
+
+
@@ -80,7 +97,6 @@ extern &quot;C&quot;
 USING_NAMESPACE(CM);
-char *dummy_string;    
 /* Important change  since version  1.6.5: virtual machine  instructions are reached  by a
@@ -157,27 +173,71 @@ char *dummy_string;
 //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   
-int counting_instructions = 0; 
-int show_syscalls = 0;    
+int            counting_instructions            = 0; 
+int            show_syscalls                    = 0;    
+
+int            start_end_debug                  = 0; 
+U32            start_debug                      = 0; 
+U32            end_debug                        = 0;    
+
+#define        vmbuf_size                       (2000)   
+char           vmbuf[vmbuf_size]; 
+
+int            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; 
-U32 anubis_empty_string; 
-U32 anubis_empty_byte_array; // initialized at start   
+#ifdef record_allocations
+int            passed                           = 0; 
+U32*           passed_seg;
+U32            passed_cnt_old                   = 0; 
+U32            passed_seg_IP                    = 0; 
+#endif   
+
+#ifdef debug_vm   
+U32            IPcode                           = 0;    
+#endif   
-int start_end_debug = 0; 
-U32 start_debug = 0; 
-U32 end_debug = 0;    
+   
-extern String anubis_directory; 
-extern String my_anubis_directory; 
-extern String trusted_certs_directory;
-extern int must_restart_flag;    
+extern         String                anubis_directory; 
+extern         String                my_anubis_directory; 
+extern         String                trusted_certs_directory;
+extern         int                   must_restart_flag;    
+   
-#define vmbuf_size (2000)   
-char vmbuf[vmbuf_size]; 
-int jpeg_fatal_error = 0;    
+   /*************************************************
+    *                                               *
+    *      (2) Tools for exceptions.                *
+    *                                               *
+    *************************************************/
+    
+       
 void jpeg_anb_error_exit(j_common_ptr cinfo)
 {
   jpeg_fatal_error = 1; 
@@ -251,21 +311,17 @@ void compare_watched_code(U32 ip)
 }
 #endif   
-//U32 memory_seg_size = initial_memory_seg_size; 
-#define check_stack(n) do { if (MAM(m_SP)+(n) >= MAM(m_SP_end)) {\
-     MAM(m_status) = need_bigger_stack; goto end; }} while(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;
+      /*****************************************************************
+       *                                                               *
+       *        (3) Tools for running virtual machines.                *
+       *                                                               *
+       *****************************************************************/
-struct timeval timeout_no_wait = {0,0}; 
+#define check_stack(n) do { if (MAM(m_SP)+(n) >= MAM(m_SP_end)) {\
+     MAM(m_status) = need_bigger_stack; goto end; }} while(0)
-#define ptd_to_name_buf_size   (1025)
-char ptd_to_name_buf[ptd_to_name_buf_size];    
 /*--------------------------------------------------------------*/
 #define item(n)   #n,
@@ -291,6 +347,7 @@ char *syscall32_names[] = {
   "dummy" }; 
 #undef sc32_item   
+   /* getting the name of an instruction */ 
 const char *instr_name(int i, int n)
 {
   if (i == i_syscall)
@@ -301,18 +358,6 @@ const char *instr_name(int i, int n)
     return instr_names[i];
 }
-//char *short_string(VMWorkSort ws)
-//{
-//  switch (ws)
-//    {
-//    case computing:        return "c"; 
-//    case deleting:         return "d";
-//    case equaling:         return "e";
-//    case serializing:      return "s";
-//    case unserializing:    return "u";
-//    default:               return "?"; 
-//    }
-//}
 #endif
@@ -350,6 +395,13 @@ const char *instr_name(int i, int n)
 #define serial_words_increment     (1024)
+
+
+   /*******************************************************
+    *                                                     *
+    *    (4) Type description tools (serialize).          *
+    *                                                     *
+    *******************************************************/ 
      /* Checking that a word represents a valid datum of a given small type. */
@@ -524,28 +576,24 @@ int check_small_alt_datum(U32 datum, U32 *start_bit_a, U8 **alt_des_a)
   return 1;
 }
-AnubisAllocator *the_default_ssl_allocator = NULL; 
-AnubisAllocator *current_ssl_allocator = NULL; 
-   
-#ifdef record_allocations
-  int passed = 0; 
-  U32* passed_seg;
-  U32 passed_cnt_old = 0; 
-  U32 passed_seg_IP = 0; 
-#endif   
-#ifdef debug_vm   
-U32 IPcode = 0;    
-#endif   
-   
-   
-   
+    /**************************************************
+     *                                                *
+     *    (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
@@ -847,7 +895,15 @@ ci_decl(peek_copy_push_function)
   /* peek d */ 
   x = *(MAM(m_SP)-get32(1)-1); 
   /* copy_function */
-  if (!(x&1)) if (*((U32 *)(x)) != 0) (*((U32 *)(x)))++; 
+  if (x&1) 
+  { /* top level function */ 
+    vcopy_module_ref((U8 *)x); 
+  }
+  else
+  { /* closure function */ 
+    if (*((U32 *)(x)) != 0) 
+      (*((U32 *)(x)))++; 
+  }
   /* push */
   *(MAM(m_SP)++) = x;  
   MAM(m_R) = x; 
@@ -863,7 +919,15 @@ ci_decl(peek_copy_function)
   /* peek d */ 
   x = *(MAM(m_SP)-get32(1)-1); 
   /* copy_function */
-  if (!(x&1)) if (*((U32 *)(x)) != 0) (*((U32 *)(x)))++; 
+  if (x&1)
+  { /* top level function */ 
+    vcopy_module_ref((U8 *)x); 
+  }
+  else
+  { /* closure function */ 
+    if (*((U32 *)(x)) != 0) 
+      (*((U32 *)(x)))++; 
+  }
   MAM(m_R) = x; 
   MAM(m_IP) += 1+4; 
 }
@@ -1062,9 +1126,15 @@ ci_decl(micro_peek_copy_function)
     /* micro_peek */ 
     MAM(m_R) = ((U32 *)(*(MAM(m_SP)-get32(1)-1)))[3+get32(5)];  
   /* copy_function */
-  if (!(MAM(m_R)&1))
+  if (MAM(m_R)&1)
+  { /* top level function */ 
+    vcopy_module_ref((U8 *)(MAM(m_R))); 
+  }
+  else
+  { /* closure function */ 
     if (*((U32 *)(MAM(m_R))) != 0)
       (*((U32 *)(MAM(m_R))))++; 
+  }
   MAM(m_IP) += 1+4+4; 
 }
@@ -1078,9 +1148,15 @@ ci_decl(micro_peek_copy_push_function)
     /* micro_peek */ 
     MAM(m_R) = ((U32 *)(*(MAM(m_SP)-get32(1)-1)))[3+get32(5)];  
   /* copy_function */
-  if (!(MAM(m_R)&1))
+  if (MAM(m_R)&1)
+  { /* top level function */ 
+    vcopy_module_ref((U8 *)(MAM(m_R))); 
+  }
+  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; 
@@ -1451,11 +1527,11 @@ ci_decl(unstore_copy_function)
    /* 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)
-    {
-      /* no virtual copy for top level functions */ 
+    { /* top level function */
+      vcopy_module_ref((U8 *)(MAM(m_R))); 
     }
   else
-    {
+    { /* closure function */ 
       if (*((U32 *)(*MAM(m_SP))) != 0)
         (*((U32 *)(*MAM(m_SP))))++; 
     }
@@ -1622,11 +1698,16 @@ ci_decl(jmp)
    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 subroutine. */ 
+   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
-  MAM(m_R) = get32(1);
+  U32 code_addr = get32(1); 
+  MAM(m_R) = code_addr;
+  vcopy_module_ref((U8 *)code_addr); 
   MAM(m_IP) += 1+4;  
 }   
@@ -1828,9 +1909,15 @@ 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)) 
+  if (datum&1)
+  { /* top level function */ 
+    vcopy_module_ref((U8 *)datum); 
+  }
+  else
+  { /* closure function */ 
     if (((U32 *)(datum))[0]) 
       (((U32 *)(datum))[0])++;
+  }
   MAM(m_IP) += 1+1+1; 
 }   
@@ -1868,9 +1955,15 @@ 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)) 
+  if (datum&1)
+  { /* top level function */ 
+    vcopy_module_ref((U8 *)datum); 
+  }
+  else
+  { /* closure function */ 
     if (((U32 *)(datum))[0]) 
       (((U32 *)(datum))[0])++; 
+  }
   MAM(m_IP) += 1+1+1+1; 
 }   
@@ -1947,12 +2040,17 @@ ci_decl(put_micro_copy_mixed)
    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. */
+   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 *)MAM(m_R))[1] = get32(1);
+  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); 
   MAM(m_IP) += 1+4+4; 
 }   
@@ -2588,16 +2686,24 @@ ci_decl(mvar_slots_del_function)
         (*(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 function is a closure */ 
-            ((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]); 
+        if (datum)                       /* beware of 0 pseudo datum */ 
+        {
+          if (datum&1) 
+          { /* top level function */ 
+            vdelete_module_ref((U8 *)datum,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 */ 
       }
 }   
@@ -3185,13 +3291,26 @@ ci_decl(copy_ptr)
    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). */
+   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))
-    if (*((U32 *)(MAM(m_R))) != 0)
+  if (MAM(m_R)&1)
+  {  /* top level function */ 
+  vcopy_module_ref((U8 *)(MAM(m_R))); 
+  }
+  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; 
 }   
@@ -3227,9 +3346,16 @@ ci_decl(vcopy_ptr)
 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)--; 
+  }
+  MAM(m_SP)--;             /* this was the number of copies required */ 
   MAM(m_IP) += 1; 
 }
@@ -3618,17 +3744,25 @@ ci_decl(del_stack_function)
   */
   /* virtual deletion of function */ 
-  if (aux &&                /* beware of NULL pointers */ 
-      !(aux&1) &&           /* don't delete top level functions */ 
-      *((U32 *)aux) &&      /* don't delete if permanent */ 
-      !(--(*((U32 *)aux))))
-    {
-      /* call micro context deletion MAM(m_code_begin) */ 
+  if (aux)                /* beware of NULL pointers */ 
+  {
+    if (aux&1)          
+    { /* top level function */ 
+      vdelete_module_ref((U8 *)aux,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; 
 }   
@@ -4144,17 +4278,25 @@ ci_decl(indirect_del_function)
 {
    trace
   U32 aux = *((U32 *)*(MAM(m_SP)-1));   /* pointer (manipulation word) to function */ 
-  if (aux &&
-      !(aux&1) &&
-      *((U32 *)aux) &&
-      !(--(*((U32 *)aux))))
-    {
-      /* call closure deletion MAM(m_code_begin) */ 
-      *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1); 
-      *(MAM(m_SP)++) = aux; 
-      MAM(m_IP) = (U8 *)(((U32 *)aux)[2]); 
-      return; 
+  if (aux)
+  {
+    if (aux&1) 
+    { /* top level function */ 
+      vdelete_module_ref((U8 *)aux,MAM(m_allocator)); 
+    }
+    else
+    { /* closure function */ 
+       if (*((U32 *)aux) &&
+           !(--(*((U32 *)aux))))
+      {
+        /* call closure deletion MAM(m_code_begin) */ 
+        *(MAM(m_SP)++) = (U32)(MAM(m_IP)+1); 
+        *(MAM(m_SP)++) = aux; 
+        MAM(m_IP) = (U8 *)(((U32 *)aux)[2]); 
+        return; 
+      }
     }
+  }
   MAM(m_IP) += 1; 
 }
@@ -4171,17 +4313,25 @@ ci_decl(incr_indirect_del_function)
   ((*(MAM(m_SP)-1))) += get8(1); 
   U32 aux = *((U32 *)*(MAM(m_SP)-1));   /* pointer (manipulation word) to function */ 
-  if (aux &&
-      !(aux&1) &&
-      *((U32 *)aux) &&
-      !(--(*((U32 *)aux))))
-    {
+  if (aux)
+  {
+    if (aux&1) 
+    { /* top level function */ 
+      vdelete_module_ref((U8 *)aux,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; 
 }
@@ -4245,17 +4395,25 @@ ci_decl(incr_indirect_del_int)
 ci_decl(del_function)
 {
    trace
-  if (MAM(m_R) &&
-      !(MAM(m_R)&1) &&
-      *((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;
+  if (MAM(m_R))         /* avoid pseudo-datum 0 */ 
+  {
+    if (MAM(m_R)&1)
+    { /* top level function */ 
+      vdelete_module_ref((U8 *)(MAM(m_R)),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; 
 }
@@ -5115,7 +5273,9 @@ ci_decl(load_float)
-/* Format:      string (U32)length (U32)counter (U8)...(U8) (U8)0
+/* 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
@@ -5123,13 +5283,34 @@ ci_decl(load_float)
    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). */ 
+   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
-  MAM(m_R) = (U32)(MAM(m_IP)+1+4);  /* address of null counter */
-  assert(*((U32 *)(MAM(m_R))) == 0); 
-  MAM(m_IP) += 1+4+4+get32(1)+1;
+   int k; 
+   int 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);
 }   
@@ -5137,8 +5318,17 @@ ci_decl(string)
 ci_decl(string_push)
 {
    trace
-  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;
+   int k; 
+   int 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+get32(1);
 }   
@@ -5147,8 +5337,6 @@ ci_decl(string_push)
-   
-   
 /* Format:          dec3 (U32)addr
    Size:            1+4
@@ -5163,364 +5351,7 @@ ci_decl(dec3)
 }   
-   
-   
-#if 0
-   the next 10 transformed into syscalls
-/* Format:         connect_file_R
-                   connect_file_W
-                   connect_file_RW
-   Size:           1
-
-   This instruction receives a string at *(MAM(m_SP)-1), which is the name of a connection. The
-   purpose is to open the connection, and  return a datum of type Maybe(?Addr(T)) for some
-   type T. However, the type T has  no importance here, because it is used only statically
-   by the  compiler.  A connection  is always  a pointer to  a data segment.  The function
-   'open_file_connection' returns 0 if the  connection cannot be (immediately) opened, and
-   1 otherwise. */
-ci_decl(connect_file_R)
-{
-   trace
-  U32 conn_seg; 
-   
-   vm_alloc2(MAM(m_R),   2,
-             conn_seg,   conn_word_size); 
-   
-  /* open the connection */ 
-  if (!open_file_connection(conn_seg,(((char *)(*(MAM(m_SP)-1)))+4),conn_read,0))
-    {
-      vm_free2(MAM(m_R),conn_seg);
-      MAM(m_R) = 0;   /* failure */ 
-    }
-  else
-    {
-      *(((U32 *)(MAM(m_R)))+1) = conn_seg; 
-      MAM(m_R) |= 1;   /* mixed index 1 */ 
-    }
-  MAM(m_IP) += 1; 
-}   
-   
-   
-   
-   
-ci_decl(connect_file_W)
-{
-   trace
-  U32 conn_seg; 
-   
-   vm_alloc2(MAM(m_R),   2,
-             conn_seg,   conn_word_size); 
-
-  /* open the connection */ 
-  if (!open_file_connection(conn_seg,(((char *)(*(MAM(m_SP)-1)))+4),conn_write,0))
-    {
-      vm_free2(MAM(m_R),conn_seg); 
-      MAM(m_R) = 0;   /* failure */ 
-    }
-  else
-    {
-      *(((U32 *)(MAM(m_R)))+1) = conn_seg; 
-      MAM(m_R) |= 1;   /* mixed index 1 */ 
-    }
-  MAM(m_IP) += 1; 
-}   
-
-      
-ci_decl(connect_file_RW)
-{
-   trace
-  U32 conn_seg; 
-   
-   vm_alloc2(MAM(m_R),  2,
-             conn_seg,  conn_word_size);
-
-  /* open the connection */ 
-  if (!open_file_connection(conn_seg,(((char *)(*(MAM(m_SP)-1)))+4),conn_write,0))
-    {
-      vm_free2(MAM(m_R),conn_seg);
-      MAM(m_R) = 0;   /* failure */ 
-    }
-  else
-    {
-      *(((U32 *)(MAM(m_R)))+1) = conn_seg; 
-      MAM(m_R) |= 1;   /* mixed index 1 */ 
-    }
-  MAM(m_IP) += 1; 
-}   
-   
-   
-/* Format:        i_connect_IP_RW
-   Size:          1
-
-   This instruction is  similar to i_connect_file_?, except that  it receives two operands
-   which are of type Word32:
-
-     at *(MAM(m_SP)-1):      ip address
-     at *(MAM(m_SP)-2):      ip port
-
-   Opening a network connection may be  non immediate. Hence, we open the connection using
-   'connect', but we test its availability using 'select'.  Each time 'select' returns the
-   answer that the connection is not yet established, we give up.
-
-   So, we need to put our two segments in MAM(m_DUC1) and MAM(m_DUC2).
-
-   The returned value has type Result(NetworkConnectError,?Addr(?)), hence is:
-
-     0         for       error(cannot_create_the_socket)
-     4         for       error(address_port_not_available)
-     8         for       error(connection_refused)
-     12        for       error(network_unreachable)
-     16        for       error(address_port_already_in_use)
-     20        for       error(out_of_time)
-     ptr|1     for       ok(conn)
-
-   where ptr is a pointer to the connection data segment. */ 
-ci_decl(connect_IP_RW)
-{   
-   trace
-  int i; 
-
-  if (!MAM(m_duc_non_empty))
-    {
-      vm_alloc2(MAM(m_DUC1), 2,
-                MAM(m_DUC2), conn_word_size); 
-   
-      /* open the connection without waiting or verifying (only once !) */
-      if((i = open_IP_connection(MAM(m_DUC2),*(MAM(m_SP)-1),*(MAM(m_SP)-2),conn_read|conn_write)) != 0)
-        {
-          switch(i)
-            {
-              /* index bit width = 2 (mixed) */ 
-            case 1: MAM(m_R) = 0; break;    // cannot create the socket
-            case 2: MAM(m_R) = 4; break;    // address:port not available on remote machine
-            case 3: MAM(m_R) = 8; break;    // connection refused by server
-            case 4: MAM(m_R) = 12; break;   // network unreachable
-            case 5: MAM(m_R) = 16; break;   // address:port already in use
-            default: MAM(m_R) = 0; break;   // cannot create the socket
-            }
-          vm_free2(MAM(m_DUC1),MAM(m_DUC2)); 
-          MAM(m_IP) += 1; 
-          return; 
-        } 
-
-      /* the socket handle has been put in the connection segment */ 
-      MAM(m_duc_non_empty) = 1; 
-    }
-
-  /* check if connection ready */ 
-  i = is_IP_connection_ready(MAM(m_DUC2)); 
-
-  if (i == 0) /* connection ready */ 
-    {
-      *(((U32 *)(MAM(m_DUC1)))+1) = MAM(m_DUC2);
-      MAM(m_R) = MAM(m_DUC1);  
-      MAM(m_R) |= 1;   /* mixed index 1 ('ok' of type 'Result') */ 
-      MAM(m_duc_non_empty) = 0; 
-      //printf("Connection is ready\n"); fflush(stdout);
-    }
-  else if (i == 1) /* connection not yet ready */ 
-    {
-      /* wait until next try */ 
-      //printf("Waiting for connection to be ready\n"); fflush(stdout);
-      MAM(m_steps) = 0; 
-      return; 
-    }
-  else if (i == 2)/* time is out */ 
-    {
-      vm_free2(MAM(m_DUC1),MAM(m_DUC2));
-      MAM(m_duc_non_empty) = 0; 
-      //printf("Time is out(2)\n"); fflush(stdout);
-      MAM(m_R) = 20;   /* error(out_of_time) */ 
-    }
-  else if (i == 3)
-    {
-      vm_free2(MAM(m_DUC1),MAM(m_DUC2));
-      MAM(m_duc_non_empty) = 0; 
-      MAM(m_R) = 4;   /* address:port not available on remote machine */ 
-    }
-  else
-    {
-      //printf("i = %d\n",i); fflush(stdout); 
-      assert(0); 
-    }
-  MAM(m_IP) += 1; 
-}   
-   
-   
-/* Format:           read_Word8
-   Size:             1
-
-   This instruction reads a datum of type Word8 from the connection at *(MAM(m_SP)-1). The
-   result is of type Maybe(Word8). */ 
-ci_decl(read_Word8)
-{   
-   trace
-  int c; 
-
-  c = read_byte((U8 *)(*(MAM(m_SP)-1)));
-
-  if (c == 2*EOF)
-    {
-      MAM(m_status) = waiting_for_event; 
-      MAM(m_steps) = 0;    /* wait for input (network connection) */ 
-      return; 
-    }
-  else if (c == EOF)
-    {
-      //printf("connection closed by peer\n"); fflush(stdout); 
-      MAM(m_R) = 0; /* failure */
-    }
-  else
-    {
-      MAM(m_R) = (((U8)c)<<1)|1;   /* index of width 1 (Maybe(Int8) has
-                                 width 9) */ 
-    }
-  MAM(m_IP) += 1; 
-}   
-   
-   
-   
-/* Format:       write_Word8
-   Size:         1
-
-   This instruction writes a datum of type Word8 to the connection at *(MAM(m_SP)-2).  The
-   datum to be written is at *(MAM(m_SP)-1).  The result is of type Maybe(One). */  
-ci_decl(write_Word8)
-{   
-   trace
-  MAM(m_R) = write_byte(  (U8)(*(MAM(m_SP)-1)),      /* Int8 to be written */
-                     (U8 *)(*(MAM(m_SP)-2)));   /* connection */ 
-  MAM(m_IP) += 1; 
-}   
-   
-   
-   
-/* Format:      implode
-   Size:        1
-
-   This instruction  receives a datum of  type List(Word8) at *(MAM(m_SP)-1)  and constructs the
-   corresponding string. */ 
-ci_decl(implode)
-{
-   trace
-  int n = 0; 
-  U32 l = *(MAM(m_SP)-1); 
-  U32 str; 
-
-  /* compute length of list */ 
-  while (l&1)   /* 0 is the empty List(Int8). */ 
-    {
-      n++; 
-      l = *((U32 *)(((U8 *)(l&pointer_mask))+4+1)); 
-    }
-
-  /* allocate 4+n+1 bytes for a string */ 
-  n += 4+1;    
-  vm_alloc1(str,byte_size_to_word_size(n));
-
-  /* initialize the string and copy its content */ 
-  l = *(MAM(m_SP)-1); 
-  n = 4; 
-  while (l&1)
-    {
-      ((U8 *)str)[n++] = (U8)(*(((U8 *)(l&pointer_mask))+4)); 
-      l = *((U32 *)(((U8 *)(l&pointer_mask))+4+1)); 
-    }
-  ((U8 *)str)[n] = 0; 
-  MAM(m_R) = str; 
-  MAM(m_IP) += 1; 
-}   
-   
-   
-   
-/* Format:          explode
-   Size:            1
-
-   This  instruction  receives a  string  at  *(MAM(m_SP)-1) and  constructs  the  list of  its
-   characters in the form of a List(Int8). */ 
-ci_decl(explode)
-{
-   trace
-  char *str = ((char *)(*(MAM(m_SP)-1)))+4; 
-  U32 aux; 
-
-  if (!MAM(m_duc_non_empty))
-    {
-      /* no datum under construction */ 
-      if (str[0] == 0)  /* the string is empty */ 
-        {
-          MAM(m_R) = 0; /* empty List(Int8) */ 
-          MAM(m_IP) += 1; 
-          return; 
-        }
-      else
-        {
-          MAM(m_DUC1) = 0; /* start with an empty list */ 
-          MAM(m_DUC2) = 0; /* put the index of next character to be
-                         'paired' in MAM(m_DUC2). */ 
-          while (str[(MAM(m_DUC2))] != 0) MAM(m_DUC2)++;
-          (MAM(m_DUC2))--; /* index of last character in string */ 
-          MAM(m_duc_non_empty) = 1; 
-          /* continue with 'datum under construction' */ 
-        }
-    }
-
-  /* Here, there is a datum under construction. The list constructed
-     so far is in MAM(m_DUC1), and the index of the next character to be
-     put in a pair is in MAM(m_DUC2) (it may be zero, but in any case there
-     is still one character to be ''paired''). 
-
-     Note: the string is read from the end towards the beginning. */ 
-
-  while (1)
-    {
-      vm_alloc1(aux,3); 
-   
-      /* counter is already at 1 */ 
-      *(((U8 *)aux)+4) = str[MAM(m_DUC2)];        /* store the character as the head */
-      *((U32 *)(((U8 *)aux)+4+1)) = MAM(m_DUC1);  /* store the tail of list */
-      aux |= 1;   /* glue mixed index */ 
-
-      if (MAM(m_DUC2) == 0)  /* this was the last character to store */
-        {
-          MAM(m_duc_non_empty) = 0; 
-          MAM(m_R) = aux; 
-          break; 
-        }
-      else
-        {
-          MAM(m_DUC1) = aux;   /* new list under construction */
-          (MAM(m_DUC2))--;     /* prepare for next character */
-        }
-    }
-  MAM(m_IP) += 1; 
-}   
-   
-   
-   
-      
-/* Format:          truncate_to_word8
-   Size:            1
-      */
-ci_decl(truncate_to_word8)
-{
-   trace
-  int i = (int)(*(MAM(m_SP)-1)); 
-  if (i < 0) 
-    MAM(m_R) = 0; 
-  else if (i > 255) 
-    MAM(m_R) = 255; 
-  else
-    MAM(m_R) = i;
-  MAM(m_IP) += 1; 
-}   
-#endif   
-   
-   
-   
-   
-
-   
+     
 /* Format:             alt_number_direct (U8)index_width 
    Size:               1+1
@@ -5551,42 +5382,6 @@ ci_decl(alt_number_indirect)
-
-   
-   
-   
-   
-   
-   
-   
-   
-   
-   
-   
-   
-   
-   
-   
-   
-   
-
-   
-   
-   
-   
-   
-   
-   
-   
-   
-   
-   
-   
-   
-   
-   
-   
-   
 /* Format:        start (U8)depth (U32)addr
    Size:          6
@@ -5710,11 +5505,15 @@ ci_decl(copy_stack_function)
 {   
    trace
   U32 f = (*(MAM(m_SP)-(1+get8(1))));
-  if (!(f&1))
-    {
-      assert(f); 
-      if (*((U32 *)f) != 0) (*((U32 *)f))++;
-    }
+  if (f&1)
+  { /* top level function */ 
+    vcopy_module_ref((U8 *)f); 
+  }
+  else
+  { /* closure function */ 
+    assert(f); 
+    if (*((U32 *)f) != 0) (*((U32 *)f))++;
+  }
   MAM(m_IP) += 1+1;
 }
@@ -5893,92 +5692,6 @@ ci_decl(del_gv)
-#if 0
-   transformed into a syscall
-   
-   
-static U8 vm_hex_digit(int b)
-{
-  if (b < 10) return '0'+b; 
-  else        return 'a'+b-10; 
-}
- 
-      
-/* Format:            byte_array_to_ascii
-   Size:              1
-
-   Expect a 'ByteArray' on top of stack,  and produces a string with a pair of hexadecimal
-   digits for each byte. */ 
-ci_decl(byte_array_to_ascii)
-{   
-   trace
-  int i, j; 
-  char *dest; 
-  U8 *array = (U8 *)(*(MAM(m_SP)-1)); 
-  U32 n = *((U32 *)(array+4));  /* number of bytes */ 
-
-  vm_alloc1(MAM(m_R),byte_size_to_word_size(4+(2*n)+1));
-   
-  array += 8;                   /* point to first byte */ 
-  dest = ((char *)MAM(m_R))+4;         /* avoid counter in destination */ 
-  j = 0; 
-
-  for (i = 0 ; i < (int)n; i++)
-    {
-      dest[j++] = vm_hex_digit(((array[i])>>4)&0xF); 
-      dest[j++] = vm_hex_digit((array[i])&0xF); 
-    }
-  assert(j == (int)(2*n)); 
-  dest[j] = 0;    /* end of string */ 
-  MAM(m_IP) += 1; 
-}
-#endif   
-   
-   
-   
-   
-   
-   
-   
-   
-#if 0
-   transformed into a syscall
-/* Format:             byte_array_to_string
-   Size:               1
-   
-   Expects a byte array on the stack and produces the longuest string which is a prefix of
-   it. */ 
-ci_decl(byte_array_to_string)
-{   
-   trace
-  int i, l; 
-  U8 *array = (U8 *)(*(MAM(m_SP)-1)); 
-  U32 n = *((U32 *)(array+4));   /* length of byte array */ 
-   
-  array += 8; 
-   
-  /* compute length of string */ 
-  for ( l = 0; l < (int)n; l++)
-    if (array[l] == 0) break; 
-   
-  /* the length of the string is l */
-   
-  vm_alloc1(MAM(m_R),byte_size_to_word_size(4+l+1)); 
-   
-  for (i = 0; i < l; i++)
-    ((U8 *)MAM(m_R))[i+4] = array[i]; 
-  ((U8 *)MAM(m_R))[i+4] = 0; 
-  MAM(m_IP) += 1; 
-}
-   
-#endif   
-   
-   
-   
-   
-   
-   
-   
 /* Format:          success (U8)bit_width
    Size:            1+1
@@ -6104,10 +5817,6 @@ ci_decl(odd_align)     /* this one is required but never executed */
    trace
 }
-ci_decl(load_adm)
-{
-   trace
-}
 ci_decl(dummy)
 {
@@ -6152,6 +5861,8 @@ ci_decl(begin_op)
    function beginning followed  by a single byte indicating if this  call is terminal call
    or not.
 */ 
+
+
 ci_decl(end_op)
 {
 	trace
@@ -6231,7 +5942,11 @@ 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)
@@ -6281,8 +5996,7 @@ int AnubisProcess::RunMachine(int steps)
 #ifdef WATCH_CODE
       compare_watched_code(prev_IP-MAM(m_code_begin)); 
 #endif   
-   
-   
+      
       m_steps--; 
     }
 #undef CARG   
@@ -6292,5 +6006,4 @@ int AnubisProcess::RunMachine(int steps)
- 
@@ -18,6 +18,7 @@ extern U8 *duplicate_code;
 extern U32 watched_code_size;    
 #endif   
+#define debug_vm   
 #ifdef DEBUG   
 // Only defines following macro on debug mode
@@ -206,6 +207,11 @@ extern void serialize_float(double d, U8 *dest);
 #define inf(x,y)   ((x)<(y) ? (x) : (y))
 #define sup(x,y)   ((x)<(y) ? (y) : (x))   
+
+
+
+   
+   
 struct Exec_Mod_struct {
   U32      flags;                 /* also indicates is primary or secondary ('mf_secondary_adm' in 'bytecode.h') */
@@ -228,27 +234,39 @@ struct Exec_Mod_struct {
     }; 
-extern int  /* 0 = out of memory, 1 = ok */  
-   add_module(  U32 flags, 
-                U8* byte_code,
-                int starting_point,
-                AnubisAllocator *allocator
-             ); 
-      
-extern U32 number_of_modules;       
-      
-      
    /*************************************************** 
     *                                                 *
     *  Dynamic modules stuff (added in version 1.13)  * 
     *                                                 *
     ***************************************************/
+
+extern U32 number_of_modules;       
+            
    /* Array of all modules, including the primary one ('the_primary_module' is kept anyway) */ 
 extern struct Exec_Mod_struct *   modules;      /* (in dynamic_module.c) */
    /* Initializing/resizing this array */ 
 extern int resize_modules_array(void);    /* 0 = out of memory, 1 = ok  (initialization in anbexec.cpp) */
+extern int  /* 0 = out of memory, 1 = ok */  
+   add_module(  U32 flags, 
+                U8* byte_code,
+                int starting_point,
+                AnubisAllocator *allocator
+             ); 
+
+/* garbage-collector tools for modules */ 
+extern void vcopy_module_ref(U8 *ref); 
+extern void multiple_vcopy_module_ref(U8 *ref,U32 n);
+extern void vdelete_module_ref(U8 *ref, AnubisAllocator *allocator);
+
+
+
+
+
+
+
+
 extern void check_module_integrity(void); 
@@ -1116,17 +1116,19 @@ void link_globals_and_relocate(U8* code, int size)
         case i_string_push:
           if (nsc_file != NULL)
             {
-              fprintf(nsc_file,"\n%8d |   %s %ld %ld (\"",ptr-code,instr_names[*ptr],
-                      *((U32 *)(ptr+1)),*((U32 *)(ptr+5)));
-              for (k = 0; k < (int)(*((U32 *)(ptr+5))); k++)
+              fprintf(nsc_file,"\n%8d |   %s %ld (\"",ptr-code,instr_names[*ptr],
+                      *((U32 *)(ptr+1)));
+              for (k = 0; k < (int)(*((U32 *)(ptr+1))); k++)
                 {
-                  fprintf(nsc_file,"%c",(*(ptr+9+k))^172);
+                  fprintf(nsc_file,"%c",(*(ptr+5+k))^172);
                 }
               fprintf(nsc_file,"\")");
             }
-          ptr += 1+4+4;
-          while (*ptr != 172) *(ptr++) ^= 172;
-          *(ptr++) ^= 172;
+          for (k = 0;  k < (int)(*((U32 *)(ptr+1))); k++)
+          {
+            *(ptr+k+5) ^= 172; 
+          }
+          ptr += 5+(int)(*((U32 *)(ptr+1))); 
           break;
         /* (U8)instr (U8)dec [dec align bytes] (U32)counter