/* vminstr.c ***************************************************

                     Anubis Compiler
           Managing virtual machine instructions.

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

#include <string.h>   
#include <time.h>
#include "cipher.h"
#include "compil.h"
#include "bytecode.h"


   
   
int C_struct_id(Expr name)
{
#define item(n)   if (name == pdstr_##n) return C_struct_id_##n;
   C_struct_list
#undef item   
  internal_error("Not a C structure name",name); 
  return 0;
}


    
   
/* finding quickly what labels represent */    
   
  
/* The index for symbolic code labels. */ 
LabelIndexArray label_index[256];    

   
void init_label_index(void)
{
  int i;
  for (i = 0; i < 256; i++)
    {
      label_index[i].max = 100; 
      label_index[i].next = 0; 
      label_index[i].array = (LabelIndexEntry *)mallocz(100*sizeof(LabelIndexEntry)); 
    }
}
   
static U8 u8_label_hash(Expr x)
{
  U8 result = 0; 
  assert(is_integer(x));
   
  result += (U8)((x)>>24); 
  result += (U8)((x>>16)&0xFF);
  result += (U8)((x>>8)&0xFF);
  result += (U8)((x)&0xFF);
   
  return result; 
}
   
   
/* Adding an entry */ 
void add_label_index_entry(Expr label, LabelSort sort, int index)   
{
  U8 hash; 
  U32 next; 
  LabelIndexEntry *array;
   
  if (sort == labs_none) return; 
   
  hash = u8_label_hash(label); 
  next = label_index[hash].next; 
  array = label_index[hash].array;
  if (next >= label_index[hash].max)
    {
      //printf("Enlarging array for hash %d in label index.\n",hash); 
      label_index[hash].max += 100; 
      label_index[hash].array = reallocz(array,(label_index[hash].max)*sizeof(LabelIndexEntry)); 
      array = label_index[hash].array;
    }
  array[next].label = label;
  array[next].sort = sort;
  array[next].index = index;
  (label_index[hash].next)++; 
}
   
   
   
/* Producing a new address name. Address names are generated from a counter. */
int new_addr_count = 0; 
Expr _new_addr_name(LabelSort sort, int index)
{
  Expr addr = new_integer(new_addr_count++);
  add_label_index_entry(addr,sort,index);
  return addr; 
}

   
   
/* Finding the entry for a label */ 
LabelIndexEntry *quick_find_label_entry(Expr label)
{
  int i; 
  U8 hash = u8_label_hash(label); 
  LabelIndexEntry *array = (label_index[hash]).array; 
   
  i = ((label_index[hash]).next) - 1; 
  for( ; i >= 0; i--)
    if (array[i].label == label) return &(array[i]); 
   
  internal_error("Cannot find label in 'label_index'",label);
  return NULL; 
}
   
   
#if 1
/* return symbolic offline code associated to a label, or nil */
static Expr scode_from_label(Expr instr, Expr addr)
{
  Expr result; 
  LabelIndexEntry *e = quick_find_label_entry(addr); 
   
  switch(e->sort) 
    {
    case labs_closure:         
      //printf("closure\n"); 
      result = closure_codes[e->index].offline_code;
      break; 
   
    case labs_compiled_op:     
      //printf("compiled_op\n"); 
      result = compiled_ops[e->index].offline_code;
      break;
   
    case labs_del_code:  
      //printf("del_code\n");    
      result = del_codes[e->index].offline_code;
      break; 
   
    case labs_mctxt_del_code:  
      //printf("mctxt_del_code\n"); 
      result = mctxt_del_codes[e->index].offline_code;
      break;
   
    case labs_implem:          
      //printf("implem\n"); 
      if (implems[e->index].offline_code == nil)
        implems[e->index].offline_code = save(offline_pseudo_code(e->index));
      result = implems[e->index].offline_code;
      break; 
   
    default: 
      assert(0); 
      break; 
    }  
  return result; 
}
#endif   
   
   



/* get the size (in bytes) of final instruction */ 
int instruction_size(Expr instr, int offset)
{
   
  //debug(instr); 
   
  if (consp(instr))
    switch(car(instr))
      {
      case label:               
      case ret_point:
      case header:
      case comment: 
      case context:
      case code_for:
      case type_list:
 return 0; 

      case ret:
 return 1; 

      case glue_index:    
      case glue:
      case store_index:
      case store_0:
      case store_1:
      case store_2:
      case store_4:
      case glue_mixed_index:    
      case unstore:
      case store:  
      case index_direct:
      case alt_number_direct:
      case unstore_copy_ptr:
      case unstore_copy_function:
      case unstore_copy_int:
      case alloc:
      case increment_del:
      case increment_eq:
      case copy_mixed:
      case vcopy_mixed:
      case copy_stack_ptr:
      case copy_stack_function:
      case copy_stack_int:
      case mixed_alt_begin:
      case large_alt_begin:
      case mixed_alt_end:
      case large_alt_end:
      case revert_to_computing:
      case success:
      case indirect_del_struct_ptr:
      case mvar_slots_del_struct_ptr:
      case apply:                
      case incr_indirect_del_ptr:
      case incr_indirect_del_function:
      case incr_indirect_del_conn:
      case incr_indirect_del_int:
 return 2;  

      case unglue:
      case unstore_copy_mixed:
      case copy_stack_mixed:
      case put_copy_direct:
      case put_copy_indirect:
      case put_copy_function:
      case incr_indirect_del_struct_ptr:
      case put_copy_int:
 return 3; 

      case put_copy_mixed:
      case put_micro_copy_direct:
      case put_micro_copy_indirect:
      case put_micro_copy_function:
      case put_micro_copy_int:
 return 4; 

 //      case load:
      case load_word32: 
      case put_micro_copy_mixed:
      case peek:
      case peek_push:
      case peek_copy_push_ptr:
      case peek_copy_push_function:
      case peek_copy_push_int:
      case peek_copy_ptr:
      case peek_copy_function:
      case peek_copy_int:
      case address:             
      case jmpf:             
      case gv_address:             
      case jmp:
      case del:
      case jmp_eq_stack:
      case false_jmp:
      case jmp_false:
      case true_jmp:
      case indirect_del:
      case indirect_del_mvar:
      case jmp_neq:
      case collapse:
      case create_vars:
      case eq:
      case call: 
      case jmp_neq_indexes_large:
      case jmp_neq_string:
      case jmp_neq_byte_array:
      case jmp_neq_int:
      case push_addr:
      case del_stack_ptr:
      case del_stack_conn:
      case del_stack_function:
      case del_stack_int:
      case init_gv:
      case serialize:
      case unserialize:
      case type_large:
      case indirect_type_large:
      case dec3:
      case check_stack:
      case unprotect:
      case del_gv:
      case get_var_handler:
      case get_mvar_handler:
      case mvar_slots_del:
      case mvar_slots_del_mvar:
      case mvar_slots_del_var:
    return 5; 

      case incr_indirect_del:
      case incr_indirect_del_mvar:
      case indirect_del_mixed:
      case del_mixed:
      case mvar_slots_del_mixed:
      case select_index_indirect:
      case start:
      case type_mixed:
      case indirect_type_mixed:
      case del_stack_struct_ptr:
   case end_op:
      case peek_copy_push_mixed:
      case peek_copy_mixed:
 return 6; 

      case select_index_direct:
      case jmp_neq_indexes_mixed:
      case incr_indirect_del_mixed:
 return 7; 

      case del_stack:
      case load_float:
      case del_stack_var:
      case del_stack_mvar:
      case micro_peek: 
      case micro_peek_push: 
      case micro_peek_copy_ptr:
      case micro_peek_copy_push_ptr:
      case micro_peek_copy_function:
      case micro_peek_copy_push_function:
      case micro_peek_copy_int:
      case micro_peek_copy_push_int:
      case put_closure_labels:
      case mcollapse:
 return 9; 

      case del_stack_mixed:
      case micro_peek_copy_mixed:
      case micro_peek_copy_push_mixed:
 return 10;

      case load_module:
        return 1+4+length(cdr(instr));
   
      case _switch:
      case type_large_switch:
 return 2 + 4*length(cdr(instr));  

      case load_int_small: /* (load_int_small 256-bigit ... 256-bigit) */
      case load_int_small_push:
        return 5; 
   
      case word_64_push:
      case word_64: return 17;    /* instr + dec + 3bytes + cnt + word1 + word 0 */ 
   
      case word_128_push:
      case word_128: return 25;   /* instr + dec + 3bytes + cnt + word3 + word2 + word1 + word 0 */ 
   
      case load_int_big: /* (load_int_big 256-bigit ... 256-bigit) */
      case load_int_big_push: 
        {
          U32 n = length(cdr(instr));  /* number of 256-bigits */ 
          while (n&3) n++;    /* compute number of bytes in 2^32-bigits */ 
          return 13 + n;      /* 1     instruction
                                 1     number of alignment bytes before the number 
                                 3     alignment bytes (total is always 3) 
                                 4     counter (= 0, i.e. permanent datum)
                                 4     number of 2^32-bigits 
                                 n     number of bytes in 2^32-bigits 
                   total:        13 + n */
        }
   
      case type_mixed_switch:
 return 3 + 4*length(cdr2(instr));  

      case type_small_alt: /* (type_small_alt n_1 ... n_k) ==> 1+4+k */ 
      case type_8:
      case type_16:
      case type_32:
      case indirect_type_8:
      case indirect_type_16:
      case indirect_type_32:
        return 1+4+length(cdr(instr)); 
   
      case string:
      case string_push:
 return 1+4+4+strlen(string_content(compiled_strings[integer_value(cdr(instr))].string))+1; 
   
      case program:
        {
          int result = 0; 
          instr = cdr(instr); 
          while (consp(instr))
            {
              result += instruction_size(car(instr),offset+result);
              instr = cdr(instr); 
            }
          return result; 
        }

   case begin_op:
    return 26;

#define sc32_item(n,f)  case n:
   syscall32_list
#undef sc32_item
   return 1+2+4;        /* 'syscall' byte + index of function (2 bytes) + 32 bits operand */ 
   
   
      }
  else
    switch(instr)
      {
      case odd_align:
        if (offset&1) return 0; else return 1; 

      case no_instr:
        return 0; 
   
      case ret_if_zero:
      case get_var_monitors:
      case get_mvar_monitors:
      case del_index_direct:
      case del_index_indirect:
      case indirect_del_ptr:
      case indirect_del_function:
      case indirect_del_int:
      case del_function:
      case del_int:
      case indirect_del_conn:
      case invalid:
      case free_var_seg:
      case free_mvar_seg:
      case create_var:
      case create_mvar:
      case get_vv:
      case get_mvv:
      case xchg_vv:
      case xchg_mvv:
      case push:
      case push_mvar_length: 
      case remove_monitor:
      case pop1:
      case pop3:
      case swap:
      case push_eq_data:
      case push_before_eq:
      case copy_ptr:
      case copy_function:
      case copy_int:
      case vcopy_ptr:
      case vcopy_int:
      case vcopy_null:
      case index_indirect:
      case free_seg_0:
      case free_seg_1_pop2_ret:
      case eq_string:
      case eq_byte_array:
      case eq_int:
      case give_up:
      case start_debug_avm:
      case stop_debug_avm:
      case del:        /* it seems that this one doesn't exist; see (del . <addr>) above */ 
      case del_ptr:
      case del_conn:
      case mvar_slots_del_conn:
      case mvar_slots_del_ptr:
      case mvar_slots_del_function:
      case mvar_slots_del_int:
      case finish:
      case get_gvv:
      case xchg_gvv:
      case type_0:
      case unlock:
      case lock:
      case indirect_type_0:
      case nop:
   /* primitive types pseudo-instructions */ 
#define item(n)   case n: 
      primitive_types_list
#undef item
#define item(n)   case indirect_##n:
      primitive_types_list
#undef item
        return 1; 

   
      /* system calls */ 
   
#define sc_item(n,f)  case n:
   syscall_list
#undef sc_item
   return 1+2;        /* 'syscall' byte + index of function (2 bytes) */ 
   
   /* the next 10 transformed into syscalls
      case connect_file_R:
      case connect_file_W:
      case connect_file_RW:
      case connect_IP_RW:
      case read_Word8:
      case write_Word8:
      case implode:
      case explode:
      case truncate_to_word8:
   */
        //case now: transformed into a syscall
        //case convert_time_from_int: transformed into a syscall
        //case convert_time_to_int: transformed into a syscall
      case pending_event:
        //case byte_array_to_ascii: transformed into a syscall
        //case byte_array_to_string: transformed into a syscall
      case alt_number_indirect:
 return 1; 

      case protect:
        return 2; 
      
      case location:
 return 4; 
   
      case initialization_address: 
      case variables_deletion_address:
        return 5; 

      }
  internal_error("Cannot compute the size of instruction",instr); 
  return 0; 
}
   

   
static Expr first_4(Expr l)   /* the list 'l' is supposed to have at least 4 elements.
   This function returns these 4 elements. */
{
  return list4(first(l),second(l),third(l),forth(l)); 
}
   
   
void translate_instruction(U8 *code_addr, 
                           U8 **ptr, 
                           U32 *module_flags, 
                           int *offsets, 
                           Expr instr, 
                           Expr initialization_address_value,
                           Expr variables_deletion_address_value)
{
  int len, i; 
  Expr aux; 
   
  if (consp(instr))
    switch(car(instr))
      {
      case label:
      case ret_point:
      case header:
      case comment:
      case context: 
      case code_for:
      case type_list: 
        break; 

      case apply: /* (apply . k) */ 
        *((*ptr)++) = i_apply; 
        *((*ptr)++) = (U8)(integer_value(cdr(instr))); 
        break; 

      case ret:
        *((*ptr)++) = i_ret; 
        break; 

      case copy_stack_ptr: /* (copy_stack_ptr . <depth>) */ 
        *((*ptr)++) = i_copy_stack_ptr; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case copy_stack_function: /* (copy_stack_function . <depth>) */ 
        *((*ptr)++) = i_copy_stack_function; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case copy_stack_int: /* (copy_stack_int . <depth>) */ 
        *((*ptr)++) = i_copy_stack_int; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case mixed_alt_begin: /* (mixed_alt_begin . <byte width>) */ 
        *((*ptr)++) = i_mixed_alt_begin; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case large_alt_begin: /* (large_alt_begin . <byte width>) */ 
        *((*ptr)++) = i_large_alt_begin; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case mixed_alt_end: /* (mixed_alt_end . <index>) */ 
        *((*ptr)++) = i_mixed_alt_end; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case large_alt_end: /* (large_alt_end . <index>) */ 
        *((*ptr)++) = i_large_alt_end; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case revert_to_computing:   /* (revert_to_computing . <type width>) */ 
        *((*ptr)++) = i_revert_to_computing; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case success:   /* (success . <type width>) */ 
        *((*ptr)++) = i_success; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case glue_index:    /* (glue_index . i) */ 
        *((*ptr)++) = i_glue_index; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case glue:    /* (glue . bw) */ 
        *((*ptr)++) = i_glue; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case store_index:   /* (store_index . i) */ 
        *((*ptr)++) = i_store_index; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case store_0:
        *((*ptr)++) = i_store_0; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case store_1:
        *((*ptr)++) = i_store_1; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case store_2:
        *((*ptr)++) = i_store_2; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case store_4:
        *((*ptr)++) = i_store_4; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case glue_mixed_index:   /* (glue_mixed_index . i) */ 
        *((*ptr)++) = i_glue_mixed_index;
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case index_direct:  /* (index_direct . <bit width>) */ 
        *((*ptr)++) = i_index_direct; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case alt_number_direct:  /* (alt_number_direct . <bit width>) */ 
        *((*ptr)++) = i_alt_number_direct; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case increment_del:  /* (increment_del . <byte width>) */ 
        *((*ptr)++) = i_increment_del; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case increment_eq:  /* (increment_eq . <byte width>) */ 
        *((*ptr)++) = i_increment_eq; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case unglue:     /* (unglue <bit width> . <right shift>) */ 
        *((*ptr)++) = i_unglue; 
        *((*ptr)++) = integer_value(second(instr)); 
        *((*ptr)++) = integer_value(cdr2(instr)); 
        break; 

      case unstore:     /* (unstore <offset> . [0|1|2|4]) -->
                           unstore_? <offset> */ 
        {
          int i = integer_value(cdr2(instr)); 
          int i_code = i == 0 ? i_unstore_0 : i == 1 ? i_unstore_1 : i == 2 ? i_unstore_2 : i_unstore_4; 
          *((*ptr)++) = i_code;
          *((*ptr)++) = integer_value(second(instr));
        }
        break;  

   
      case unstore_copy_mixed: /* (unstore_copy_mixed <offset> . <mask>) */ 
        *((*ptr)++) = i_unstore_copy_mixed;
        *((*ptr)++) = integer_value(second(instr));
        *((*ptr)++) = integer_value(cdr2(instr));
        break; 

      case copy_stack_mixed: /* (copy_stack_mixed <depth> . <mask>) */ 
        *((*ptr)++) = i_copy_stack_mixed;
        *((*ptr)++) = integer_value(second(instr));
        *((*ptr)++) = integer_value(cdr2(instr));
        break; 

      case put_copy_direct: /* (put_copy_direct <depth> . <pos>) */ 
        *((*ptr)++) = i_put_copy_direct;
        *((*ptr)++) = integer_value(second(instr));
        *((*ptr)++) = integer_value(cdr2(instr));
        break; 

      case put_copy_indirect: /* (put_copy_indirect <depth> . <pos>) */ 
        *((*ptr)++) = i_put_copy_indirect;
        *((*ptr)++) = integer_value(second(instr));
        *((*ptr)++) = integer_value(cdr2(instr));
        break; 

      case put_copy_function: /* (put_copy_function <depth> . <pos>) */ 
        *((*ptr)++) = i_put_copy_function;
        *((*ptr)++) = integer_value(second(instr));
        *((*ptr)++) = integer_value(cdr2(instr));
        break; 

      case put_copy_int: /* (put_copy_int <depth> . <pos>) */ 
        *((*ptr)++) = i_put_copy_int;
        *((*ptr)++) = integer_value(second(instr));
        *((*ptr)++) = integer_value(cdr2(instr));
        break; 

      case put_copy_mixed: /* (put_copy_mixed <mask> <depth> . <pos>) */ 
        *((*ptr)++) = i_put_copy_mixed;
        *((*ptr)++) = integer_value(second(instr));
        *((*ptr)++) = integer_value(third(instr));
        *((*ptr)++) = integer_value(cdr3(instr));
        break; 

      case put_micro_copy_direct: /* (put_micro_copy_direct <depth> <micro depth> . <pos>) */ 
        *((*ptr)++) = i_put_micro_copy_direct;
        *((*ptr)++) = integer_value(second(instr));
        *((*ptr)++) = integer_value(third(instr));
        *((*ptr)++) = integer_value(cdr3(instr));
        break; 

      case put_micro_copy_indirect: /* (put_micro_copy_indirect <depth> <micro depth> . <pos>) */ 
        *((*ptr)++) = i_put_micro_copy_indirect;
        *((*ptr)++) = integer_value(second(instr));
        *((*ptr)++) = integer_value(third(instr));
        *((*ptr)++) = integer_value(cdr3(instr));
        break; 

      case put_micro_copy_function: /* (put_micro_copy_function <depth> <micro_depth> . <pos>) */ 
        *((*ptr)++) = i_put_micro_copy_function;
        *((*ptr)++) = integer_value(second(instr));
        *((*ptr)++) = integer_value(third(instr));
        *((*ptr)++) = integer_value(cdr3(instr));
        break; 

      case put_micro_copy_int: /* (put_micro_copy_int <depth> <micro_depth> . <pos>) */ 
        *((*ptr)++) = i_put_micro_copy_int;
        *((*ptr)++) = integer_value(second(instr));
        *((*ptr)++) = integer_value(third(instr));
        *((*ptr)++) = integer_value(cdr3(instr));
        break; 

      case put_micro_copy_mixed: /* (put_micro_copy_mixed <mask> <depth> <micro depth> . <pos>) */ 
        *((*ptr)++) = i_put_micro_copy_mixed;
        *((*ptr)++) = integer_value(second(instr));
        *((*ptr)++) = integer_value(third(instr));
        *((*ptr)++) = integer_value(forth(instr));
        *((*ptr)++) = integer_value(cdr4(instr));
        break; 

      case unstore_copy_ptr: /* (unstore_copy_ptr . <offset>) */ 
        *((*ptr)++) = i_unstore_copy_ptr; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break;  

      case unstore_copy_function: /* (unstore_copy_function . <offset>) */ 
        *((*ptr)++) = i_unstore_copy_function; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break;  

      case unstore_copy_int: /* (unstore_copy_int . <offset>) */ 
        *((*ptr)++) = i_unstore_copy_int; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break;  

      case alloc:     /* (alloc . <num bytes>)  -->
                         i_alloc <num words>-2 */ 
        {
          int i = integer_value(cdr(instr)); 
          if ((i & 3) == 0) i--; 
          i = (i>>2) - 1;  /* <num words>-2 */  
          *((*ptr)++) = i_alloc; 
          *((*ptr)++) = (U8)i;  
        }
        break; 

   
#ifdef never_defined
      case load:     /* (load . <address>) */ 
        *((*ptr)++) = i_load; 
        *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
        break; 
#endif

      case check_stack: /* (check_stack . n) */ 
        *((*ptr)++) = i_check_stack; 
        *(((U32 *)(*ptr))) = integer_value(cdr(instr)); 
        *ptr += sizeof(U32); 
        break; 

      case push_addr:   /* (push_addr . a) */ 
        *((*ptr)++) = i_push_addr; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))]; 
        *ptr += sizeof(U32); 
        break; 

      case select_index_direct:  /* (select_index_direct bw index . addr) */ 
        *((*ptr)++) = i_select_index_direct;
        *((*ptr)++) = (U8)(integer_value(second(instr)));
        *((*ptr)++) = (U8)(integer_value(third(instr)));
        *(((U32 *)(*ptr))) = (U32)(offsets[integer_value(cdr3(instr))]); 
        *ptr += sizeof(U32); 
        break;

      case select_index_indirect:  /* (select_index_indirect index . addr) */ 
        *((*ptr)++) = i_select_index_indirect;
        *((*ptr)++) = (U8)(integer_value(second(instr)));
        *(((U32 *)(*ptr))) = (U32)(offsets[integer_value(cdr2(instr))]); 
        *ptr += sizeof(U32); 
        break;

        /* the following may cause a problem because floats are perhaps 
           not portable */ 
      case load_float:     /* (load_float <Word32 mantissa> . <Word32 exponent>) */ 
        *((*ptr)++) = i_load_float; 
        *(((U32 *)(*ptr))) = integer_value(second(instr));   /* mantissa (always positive) */
        *ptr += sizeof(U32); 
        *(((U32 *)(*ptr))) = integer_value(cdr2(instr));     /* exponent (signed) */ 
        *ptr += sizeof(U32); 
        break; 

      case collapse:
        *((*ptr)++) = i_collapse; 
        *(((U32 *)(*ptr))) = integer_value(cdr(instr));
        *ptr += sizeof(U32); 
        break; 

      case mcollapse:
        *((*ptr)++) = i_mcollapse; 
        *(((U32 *)(*ptr))) = integer_value(second(instr));
        *ptr += sizeof(U32); 
        *(((U32 *)(*ptr))) = integer_value(cdr2(instr));
        *ptr += sizeof(U32); 
        break; 

      case create_vars: /* (create_vars . <number of variables>) */ 
        *((*ptr)++) = i_create_vars; 
        *(((U32 *)(*ptr))) = integer_value(cdr(instr));
        *ptr += sizeof(U32); 
        break; 

      case copy_mixed:
        *((*ptr)++) = i_copy_mixed; 
        *((*ptr)++) = integer_value(cdr(instr));
        break; 

      case vcopy_mixed:
        *((*ptr)++) = i_vcopy_mixed; 
        *((*ptr)++) = integer_value(cdr(instr));
        break; 

      case type_small_alt: /* (type_small_alt n1 ... n_k) -> i_type_small_alt (U32)k n1 ... nk */
        *((*ptr)++) = i_type_small_alt; 
        *(((U32 *)(*ptr))) = (U32)length(cdr(instr)); 
        *ptr += sizeof(U32); 
        {
          aux = cdr(instr); 
          while (consp(aux))
            {
              *((*ptr)++) = (U8)integer_value(car(aux)); 
              aux = cdr(aux); 
            }
        }
        break; 
   
      case type_8: /* idem */
        *((*ptr)++) = i_type_8; 
        *(((U32 *)(*ptr))) = (U32)length(cdr(instr)); 
        *ptr += sizeof(U32); 
        //debug(instr);
        {
          aux = cdr(instr); 
          while (consp(aux))
            {
              *((*ptr)++) = (U8)integer_value(car(aux)); 
              aux = cdr(aux); 
            }
        }
        break; 
   
      case type_16: /* idem */
        *((*ptr)++) = i_type_16; 
        *(((U32 *)(*ptr))) = (U32)length(cdr(instr)); 
        *ptr += sizeof(U32); 
        {
          aux = cdr(instr); 
          while (consp(aux))
            {
              *((*ptr)++) = (U8)integer_value(car(aux)); 
              aux = cdr(aux); 
            }
        }
        break; 
   
      case type_32: /* idem */
        *((*ptr)++) = i_type_32; 
        *(((U32 *)(*ptr))) = (U32)length(cdr(instr)); 
        *ptr += sizeof(U32); 
        {
          aux = cdr(instr); 
          while (consp(aux))
            {
              *((*ptr)++) = (U8)integer_value(car(aux)); 
              aux = cdr(aux); 
            }
        }
        break; 
   
      case indirect_type_8: /* idem */
        *((*ptr)++) = i_indirect_type_8; 
        *(((U32 *)(*ptr))) = (U32)length(cdr(instr)); 
        *ptr += sizeof(U32); 
        {
          aux = cdr(instr); 
          while (consp(aux))
            {
              *((*ptr)++) = (U8)integer_value(car(aux)); 
              aux = cdr(aux); 
            }
        }
        break; 
   
      case indirect_type_16: /* idem */
        *((*ptr)++) = i_indirect_type_16; 
        *(((U32 *)(*ptr))) = (U32)length(cdr(instr)); 
        *ptr += sizeof(U32); 
        {
          aux = cdr(instr); 
          while (consp(aux))
            {
              *((*ptr)++) = (U8)integer_value(car(aux)); 
              aux = cdr(aux); 
            }
        }
        break; 
   
      case indirect_type_32: /* idem */
        *((*ptr)++) = i_indirect_type_32; 
        *(((U32 *)(*ptr))) = (U32)length(cdr(instr)); 
        *ptr += sizeof(U32); 
        {
          aux = cdr(instr); 
          while (consp(aux))
            {
              *((*ptr)++) = (U8)integer_value(car(aux)); 
              aux = cdr(aux); 
            }
        }
        break; 
   
      case string:     /* (string . <index>) */ 
      case string_push:
        *((*ptr)++) = car(instr) == string ? i_string : i_string_push; 
        *(((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); 
        for (i = 0; i < len; i++)
          *((*ptr)++) = 172^((string_content(compiled_strings[integer_value(cdr(instr))].string))[i]);
        *((*ptr)++) = 172; 
        break; 

      case program:     /* (program instruction ... instruction) */ 
        {
          Expr prog = cdr(instr); 
          while(consp(prog))
            {
              translate_instruction(code_addr,ptr,module_flags,offsets,car(prog),
                                    initialization_address_value,variables_deletion_address_value); 
              prog = cdr(prog); 
            }
        }
        break; 
   
      case address:     /* (address . <address>) */ 
        *((*ptr)++) = i_address; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))];
        *ptr += sizeof(U32); 
        break; 

      case jmpf:     /* (jmpf <address> . k)      k is ignored    */ 
        *((*ptr)++) = i_jmp;   /* works exactly the same as 'jmp' */ 
        *(((U32 *)(*ptr))) = offsets[integer_value(second(instr))];
        *ptr += sizeof(U32); 
        break; 

      case gv_address:     /* (gv_address . <index>) */ 
        *((*ptr)++) = i_gv_address; 
        *(((U32 *)(*ptr))) = integer_value(cdr(instr));
        *ptr += sizeof(U32); 
        break; 

      case call:     /* (call <address> . <n>) */ 
        *((*ptr)++) = i_call; 
        *(((U32 *)(*ptr))) = offsets[integer_value(second(instr))];
        *ptr += sizeof(U32); 
        break; 

      case indirect_del:     /* (indirect_del . <address>) */ 
        *((*ptr)++) = i_indirect_del; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))];
        *ptr += sizeof(U32); 
        break; 

      case incr_indirect_del:     /* (incr_indirect_del <address> . <depl>) */ 
        *((*ptr)++) = i_incr_indirect_del; 
        *(((U32 *)(*ptr))) = offsets[integer_value(second(instr))];
        *ptr += sizeof(U32); 
        *((*ptr)++) = integer_value(cdr2(instr));    
        break; 

      case incr_indirect_del_mixed:     /* (incr_indirect_del_mixed <mask> <address> . <depl>) */ 
        *((*ptr)++) = i_incr_indirect_del_mixed; 
        *((*ptr)++) = integer_value(second(instr)); 
        *(((U32 *)(*ptr))) = offsets[integer_value(third(instr))];
        *ptr += sizeof(U32); 
        *((*ptr)++) = integer_value(cdr3(instr));    
        break; 

      case incr_indirect_del_mvar:     /* (incr_indirect_del_mvar <address> . <depl>) */ 
        *((*ptr)++) = i_incr_indirect_del_mvar; 
        *(((U32 *)(*ptr))) = offsets[integer_value(second(instr))];
        *ptr += sizeof(U32); 
        *((*ptr)++) = integer_value(cdr2(instr));    
        break; 

      case indirect_del_mvar:     /* (indirect_del_mvar . <address>) */ 
        *((*ptr)++) = i_indirect_del_mvar; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))];
        *ptr += sizeof(U32); 
        break; 

      case del_mixed:     /* (del_mixed <mask> . <address>) */ 
        *((*ptr)++) = i_del_mixed; 
        *((*ptr)++) = integer_value(second(instr)); 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr2(instr))];
        *ptr += sizeof(U32); 
        break; 

      case mvar_slots_del_mixed:     /* (mvar_slots_del_mixed <mask> . <address>) */ 
        *((*ptr)++) = i_mvar_slots_del_mixed; 
        *((*ptr)++) = integer_value(second(instr)); 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr2(instr))];
        *ptr += sizeof(U32); 
        break; 

      case type_mixed:     /* (type_mixed <mask> . <address>) */ 
        *((*ptr)++) = i_type_mixed; 
        *((*ptr)++) = integer_value(second(instr)); 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr2(instr))];
        *ptr += sizeof(U32); 
        break; 

      case indirect_type_mixed:     /* (indirect_type_mixed <mask> . <address>) */ 
        *((*ptr)++) = i_indirect_type_mixed; 
        *((*ptr)++) = integer_value(second(instr)); 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr2(instr))];
        *ptr += sizeof(U32); 
        break; 

      case indirect_del_mixed:     /* (indirect_del_mixed <mask> . <address>) */ 
        *((*ptr)++) = i_indirect_del_mixed; 
        *((*ptr)++) = integer_value(second(instr)); 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr2(instr))];
        *ptr += sizeof(U32); 
        break; 

      case indirect_del_struct_ptr:     /* (indirect_del_struct_ptr . <struct id>) */ 
        *((*ptr)++) = i_indirect_del_struct_ptr; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case incr_indirect_del_struct_ptr:     /* (incr_indirect_del_struct_ptr <struct id> . <depl>) */ 
        *((*ptr)++) = i_incr_indirect_del_struct_ptr; 
        *((*ptr)++) = integer_value(second(instr)); 
        *((*ptr)++) = integer_value(cdr2(instr)); 
        break; 

      case mvar_slots_del_struct_ptr:     /* (mvar_slots_del_struct_ptr . <struct id>) */ 
        *((*ptr)++) = i_mvar_slots_del_struct_ptr; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case jmp:     /* (jmp . <address>) */ 
        *((*ptr)++) = i_jmp; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))];
        *ptr += sizeof(U32); 
        break; 

      case false_jmp:     /* (false_jmp . <address>) */ 
        *((*ptr)++) = i_false_jmp; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))];
        *ptr += sizeof(U32); 
        break; 

      case jmp_false:     /* (jmp_false . <address>) */ 
        *((*ptr)++) = i_jmp_false; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))];
        *ptr += sizeof(U32); 
        break; 

      case true_jmp:     /* (true_jmp . <address>) */ 
        *((*ptr)++) = i_true_jmp; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))];
        *ptr += sizeof(U32); 
        break; 

      case jmp_eq_stack:     /* (jmp_eq_stack . <address>) */ 
        *((*ptr)++) = i_jmp_eq_stack; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))];
        *ptr += sizeof(U32); 
        break; 

      case jmp_neq_indexes_large:     /* (jmp_neq_indexes_large . <address>) */ 
        *((*ptr)++) = i_jmp_neq_indexes_large; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))];
        *ptr += sizeof(U32); 
        break; 

      case jmp_neq_string:     /* (jmp_neq_string . <address>) */ 
        *((*ptr)++) = i_jmp_neq_string; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))];
        *ptr += sizeof(U32); 
        break; 

      case jmp_neq_byte_array:     /* (jmp_neq_byte_array . <address>) */ 
        *((*ptr)++) = i_jmp_neq_byte_array; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))];
        *ptr += sizeof(U32); 
        break; 

      case jmp_neq_int:     /* (jmp_neq_int . <address>) */ 
        *((*ptr)++) = i_jmp_neq_int; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))];
        *ptr += sizeof(U32); 
        break; 

      case jmp_neq_indexes_mixed:     /* (jmp_neq_indexes_mixed <width> <mask> . <address>) */ 
        *((*ptr)++) = i_jmp_neq_indexes_mixed; 
        *((*ptr)++) = (U8)integer_value(second(instr)); 
        *((*ptr)++) = (U8)integer_value(third(instr)); 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr3(instr))];
        *ptr += sizeof(U32); 
        break; 

      case jmp_neq:     /* (jmp_neq <byte width> . <address>) 
                           i_jmp_neq_? <address> */
        { 
          int i = integer_value(second(instr)); 
          Expr i_instr = i == 0 ? i_jmp_neq_0 : 
            i == 1 ? i_jmp_neq_1 : 
            i == 2 ? i_jmp_neq_2 : 
            i == 4 ? i_jmp_neq_4 :
            (assert(0),0); 
          *((*ptr)++) = i_instr; 
          *(((U32 *)(*ptr))) = offsets[integer_value(cdr2(instr))];
          *ptr += sizeof(U32); 
        }
        break; 

      case peek:      /* (peek x . k) */ 
        *((*ptr)++) = i_peek; 
        *(((U32 *)(*ptr))) = integer_value(cdr2(instr));
        *ptr += sizeof(U32); 
        break; 

      case load_word32:      /* (load_word32 . <C int>) */ 
        *((*ptr)++) = i_load_word32; 
        *(((U32 *)(*ptr))) = cdr(instr);
        *ptr += sizeof(U32); 
        break; 

      case peek_push:      /* (peek_push x . k) */ 
        *((*ptr)++) = i_peek_push; 
        *(((U32 *)(*ptr))) = integer_value(cdr2(instr));
        *ptr += sizeof(U32); 
        break; 

      case peek_copy_push_ptr:      /* (peek_copy_push_ptr x . k) */ 
        *((*ptr)++) = i_peek_copy_push_ptr; 
        *(((U32 *)(*ptr))) = integer_value(cdr2(instr));
        *ptr += sizeof(U32); 
        break; 

      case peek_copy_ptr:      /* (peek_copy_ptr x . k) */ 
        *((*ptr)++) = i_peek_copy_ptr; 
        *(((U32 *)(*ptr))) = integer_value(cdr2(instr));
        *ptr += sizeof(U32); 
        break; 

      case peek_copy_push_function:      /* (peek_copy_push_function x . k) */ 
        *((*ptr)++) = i_peek_copy_push_function; 
        *(((U32 *)(*ptr))) = integer_value(cdr2(instr));
        *ptr += sizeof(U32); 
        break; 

      case peek_copy_function:      /* (peek_copy_function x . k) */ 
        *((*ptr)++) = i_peek_copy_function; 
        *(((U32 *)(*ptr))) = integer_value(cdr2(instr));
        *ptr += sizeof(U32); 
        break; 

      case peek_copy_push_int:      /* (peek_copy_push_int x . k) */ 
        *((*ptr)++) = i_peek_copy_push_int; 
        *(((U32 *)(*ptr))) = integer_value(cdr2(instr));
        *ptr += sizeof(U32); 
        break; 

      case peek_copy_int:      /* (peek_copy_int x . k) */ 
        *((*ptr)++) = i_peek_copy_int; 
        *(((U32 *)(*ptr))) = integer_value(cdr2(instr));
        *ptr += sizeof(U32); 
        break; 

      case peek_copy_push_mixed:      /* (peek_copy_push_mixed bit_mask x . k) */ 
        *((*ptr)++) = i_peek_copy_push_mixed; 
        *((*ptr)++) = integer_value(second(instr)); 
        *(((U32 *)(*ptr))) = integer_value(cdr3(instr));
        *ptr += sizeof(U32); 
        break; 

      case peek_copy_mixed:      /* (peek_copy_mixed bit_mask x . k) */ 
        *((*ptr)++) = i_peek_copy_mixed; 
        *((*ptr)++) = integer_value(second(instr)); 
        *(((U32 *)(*ptr))) = integer_value(cdr3(instr));
        *ptr += sizeof(U32); 
        break; 

      case micro_peek:      /* (micro_peek x d . k) */ 
        *((*ptr)++) = i_micro_peek;    
        *(((U32 *)(*ptr))) = integer_value(third(instr));
        *ptr += sizeof(U32); 
        *(((U32 *)(*ptr))) = integer_value(cdr3(instr));
        *ptr += sizeof(U32); 
        break; 

      case micro_peek_push:      /* (micro_peek_push x d . k) */ 
        *((*ptr)++) = i_micro_peek_push;    
        *(((U32 *)(*ptr))) = integer_value(third(instr));
        *ptr += sizeof(U32); 
        *(((U32 *)(*ptr))) = integer_value(cdr3(instr));
        *ptr += sizeof(U32); 
        break; 

      case micro_peek_copy_mixed:      /* (micro_peek_copy_mixed mask x d . k) */ 
        *((*ptr)++) = i_micro_peek_copy_mixed;    
        *((*ptr)++) = integer_value(second(instr));    
        *(((U32 *)(*ptr))) = integer_value(forth(instr));
        *ptr += sizeof(U32); 
        *(((U32 *)(*ptr))) = integer_value(cdr4(instr));
        *ptr += sizeof(U32); 
        break; 

      case micro_peek_copy_push_mixed:      /* (micro_peek_copy_push_mixed mask x d . k) */ 
        *((*ptr)++) = i_micro_peek_copy_push_mixed;    
        *((*ptr)++) = integer_value(second(instr));    
        *(((U32 *)(*ptr))) = integer_value(forth(instr));
        *ptr += sizeof(U32); 
        *(((U32 *)(*ptr))) = integer_value(cdr4(instr));
        *ptr += sizeof(U32); 
        break; 

      case micro_peek_copy_ptr:      /* (micro_peek_copy_ptr x d . k) */ 
        *((*ptr)++) = i_micro_peek_copy_ptr;    
        *(((U32 *)(*ptr))) = integer_value(third(instr));
        *ptr += sizeof(U32); 
        *(((U32 *)(*ptr))) = integer_value(cdr3(instr));
        *ptr += sizeof(U32); 
        break; 

      case micro_peek_copy_push_ptr:      /* (micro_peek_copy_push_ptr x d . k) */ 
        *((*ptr)++) = i_micro_peek_copy_push_ptr;    
        *(((U32 *)(*ptr))) = integer_value(third(instr));
        *ptr += sizeof(U32); 
        *(((U32 *)(*ptr))) = integer_value(cdr3(instr));
        *ptr += sizeof(U32); 
        break; 

      case micro_peek_copy_function:      /* (micro_peek_copy_function x d . k) */ 
        *((*ptr)++) = i_micro_peek_copy_function;    
        *(((U32 *)(*ptr))) = integer_value(third(instr));
        *ptr += sizeof(U32); 
        *(((U32 *)(*ptr))) = integer_value(cdr3(instr));
        *ptr += sizeof(U32); 
        break; 

      case micro_peek_copy_push_function:      /* (micro_peek_copy_push_function x d . k) */ 
        *((*ptr)++) = i_micro_peek_copy_push_function;    
        *(((U32 *)(*ptr))) = integer_value(third(instr));
        *ptr += sizeof(U32); 
        *(((U32 *)(*ptr))) = integer_value(cdr3(instr));
        *ptr += sizeof(U32); 
        break; 

      case micro_peek_copy_int:      /* (micro_peek_copy_int x d . k) */ 
        *((*ptr)++) = i_micro_peek_copy_int;    
        *(((U32 *)(*ptr))) = integer_value(third(instr));
        *ptr += sizeof(U32); 
        *(((U32 *)(*ptr))) = integer_value(cdr3(instr));
        *ptr += sizeof(U32); 
        break; 

      case micro_peek_copy_push_int:      /* (micro_peek_copy_push_int x d . k) */ 
        *((*ptr)++) = i_micro_peek_copy_push_int;    
        *(((U32 *)(*ptr))) = integer_value(third(instr));
        *ptr += sizeof(U32); 
        *(((U32 *)(*ptr))) = integer_value(cdr3(instr));
        *ptr += sizeof(U32); 
        break; 


      case put_closure_labels:      /* (put_closure_labels f . d) */ 
        *((*ptr)++) = i_put_closure_labels;    
        *(((U32 *)(*ptr))) = offsets[integer_value(second(instr))];
        *ptr += sizeof(U32); 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr2(instr))];
        *ptr += sizeof(U32); 
        break; 

      case unprotect: /* (unprotect . <addr>) */ 
        *((*ptr)++) = i_unprotect; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))]; 
        *ptr += sizeof(U32); 
        break; 

      case get_var_handler: /* (get_var_handler . <addr>) */ 
        *((*ptr)++) = i_get_var_handler; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))]; 
        *ptr += sizeof(U32); 
        break; 

      case get_mvar_handler: /* (get_mvar_handler . <addr>) */ 
        *((*ptr)++) = i_get_mvar_handler; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))]; 
        *ptr += sizeof(U32); 
        break; 

      case mvar_slots_del: /* (mvar_slots_del . <addr>) */ 
        *((*ptr)++) = i_mvar_slots_del; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))]; 
        *ptr += sizeof(U32); 
        break; 

      case eq:      /* (eq . k) */ 
        *((*ptr)++) = i_eq; 
        *(((U32 *)(*ptr))) = integer_value(cdr(instr));
        *ptr += sizeof(U32); 
        break; 

      case del_stack_ptr: /* (del_stack_ptr . <depth>) */ 
        *((*ptr)++) = i_del_stack_ptr; 
        *(((U32 *)(*ptr))) = integer_value(cdr(instr));
        *ptr += sizeof(U32); 
        break; 

      case del_stack_function: /* (del_stack_function . <depth>) */ 
        *((*ptr)++) = i_del_stack_function; 
        *(((U32 *)(*ptr))) = integer_value(cdr(instr));
        *ptr += sizeof(U32); 
        break; 

      case del_stack_int: /* (del_stack_int . <depth>) */ 
        *((*ptr)++) = i_del_stack_int; 
        *(((U32 *)(*ptr))) = integer_value(cdr(instr));
        *ptr += sizeof(U32); 
        break; 

      case del_stack_struct_ptr: /* (del_stack_struct_ptr <struct id> . <depth>) */ 
        *((*ptr)++) = i_del_stack_struct_ptr; 
        *((*ptr)++) = integer_value(second(instr));
        *(((U32 *)(*ptr))) = integer_value(cdr2(instr));
        *ptr += sizeof(U32); 
        break; 

      case del_stack_conn: /* (del_stack_conn . <depth>) */ 
        *((*ptr)++) = i_del_stack_conn; 
        *(((U32 *)(*ptr))) = integer_value(cdr(instr));
        *ptr += sizeof(U32); 
        break; 

      case del: /* (del . <addr>) */ 
        *((*ptr)++) = i_del; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))];
        *ptr += sizeof(U32); 
        break; 

      case mvar_slots_del_var: /* (mvar_slots_del_var . <addr>) */ 
        *((*ptr)++) = i_mvar_slots_del_var; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))];
        *ptr += sizeof(U32); 
        break; 

      case mvar_slots_del_mvar: /* (mvar_slots_del_mvar . <addr>) */ 
        *((*ptr)++) = i_mvar_slots_del_mvar; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))];
        *ptr += sizeof(U32); 
        break; 

      case del_stack: /* (del_stack <depth> . <addr>) */ 
        *((*ptr)++) = i_del_stack; 
        *(((U32 *)(*ptr))) = integer_value(second(instr));
        *ptr += sizeof(U32); 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr2(instr))];
        *ptr += sizeof(U32); 
        break; 

      case del_stack_mvar: /* (del_stack_mvar <depth> . <addr>) */ 
        *((*ptr)++) = i_del_stack_mvar; 
        *(((U32 *)(*ptr))) = integer_value(second(instr));
        *ptr += sizeof(U32); 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr2(instr))];
        *ptr += sizeof(U32); 
        break; 

      case del_stack_mixed: /* (del_stack_mixed <depth> <mask> . <addr>) */ 
        *((*ptr)++) = i_del_stack_mixed; 
        *(((U32 *)(*ptr))) = integer_value(second(instr));
        *ptr += sizeof(U32); 
        *((*ptr)++) = integer_value(third(instr));
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr3(instr))];
        *ptr += sizeof(U32); 
        break; 

      case incr_indirect_del_ptr: /* (incr_indirect_del_ptr . <depl>)*/ 
        *((*ptr)++) = i_incr_indirect_del_ptr; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case incr_indirect_del_function: /* (incr_indirect_del_function . <depl>)*/ 
        *((*ptr)++) = i_incr_indirect_del_function; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case incr_indirect_del_conn: /* (incr_indirect_del_conn . <depl>)*/ 
        *((*ptr)++) = i_incr_indirect_del_conn; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case incr_indirect_del_int: /* (incr_indirect_del_int . <depl>)*/ 
        *((*ptr)++) = i_incr_indirect_del_int; 
        *((*ptr)++) = integer_value(cdr(instr)); 
        break; 

      case init_gv: /* (init_gv . <index>) */ 
        *((*ptr)++) = i_init_gv; 
        *(((U32 *)(*ptr))) = integer_value(cdr(instr));
        *ptr += sizeof(U32); 
        break; 

      case serialize: /* (serialize . <addr>) */ 
        *((*ptr)++) = i_serialize; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))];
        *ptr += sizeof(U32); 
        break; 

      case unserialize: /* (unserialize . <addr>) */ 
        *((*ptr)++) = i_unserialize; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))];
        *ptr += sizeof(U32); 
        break; 

      case type_large: /* (type_large . <addr>) */ 
        *((*ptr)++) = i_type_large; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))];
        *ptr += sizeof(U32); 
        break; 

      case indirect_type_large: /* (indirect_type_large . <addr>) */ 
        *((*ptr)++) = i_indirect_type_large; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))];
        *ptr += sizeof(U32); 
        break; 

      case dec3: /* (dec3 . <addr>) */ 
        *((*ptr)++) = i_dec3; 
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr(instr))];
        *ptr += sizeof(U32); 
        break; 

      case start: /* (start <depth> . <addr>) */ 
        *((*ptr)++) = i_start; 
        *((*ptr)++) = integer_value(second(instr));
        *(((U32 *)(*ptr))) = offsets[integer_value(cdr2(instr))];
        *ptr += sizeof(U32); 
        break; 

      case _switch:  /* (switch a1 ... ak) -->
                        i_switch k a1 ... ak */ 
        {
          *((*ptr)++) = i_switch; 
          instr = cdr(instr); 
          *((*ptr)++) = (U8)length(instr); 
          while(consp(instr))
            {
              *(((U32 *)(*ptr))) = offsets[integer_value(car(instr))];
              *ptr += sizeof(U32); 
              instr = cdr(instr); 
            }
        } 
        break; 

      case del_gv:     /* (del_gv . index) */ 
        *((*ptr)++) = i_del_gv; 
        *(((U32 *)(*ptr))) = integer_value(cdr(instr));       
        *ptr += sizeof(U32); 
        break; 

      case type_mixed_switch:
        {
          *((*ptr)++) = i_type_mixed_switch; 
          instr = cdr(instr); 
          *((*ptr)++) = (U8)integer_value(car(instr)); 
          instr = cdr(instr); 
          *((*ptr)++) = (U8)length(instr); 
          while(consp(instr))
            {
              *(((U32 *)(*ptr))) = offsets[integer_value(car(instr))];
              *ptr += sizeof(U32);
              instr = cdr(instr); 
            }
        } 
        break; 

      case type_large_switch:
        {
          *((*ptr)++) = i_type_large_switch; 
          instr = cdr(instr); 
          *((*ptr)++) = (U8)length(instr); 
          while(consp(instr))
            {
              *(((U32 *)(*ptr))) = offsets[integer_value(car(instr))];
              *ptr += sizeof(U32); 
              instr = cdr(instr); 
            }
        } 
        break; 

   
      case word_64:  /* instr = (word_64 Cint . Cint) */ 
      case word_64_push:
        {
   
          //printf("vminstr: generating word_64 at offset %d ",(U32)((*ptr)-code_addr)-40); 
          /* 40 is the size of the header */ 
   
          /*  is realized as follows:
   
              word_64   1 byte      the instruction itself
              dec       1 byte      number of alignment bytes
              0         1 byte      alignment byte (there are 'dec' alignement bytes)
              ...
              0         4 bytes     counter for permanent datum (= 0) must be at a 0 mod 4 offset
              high      4 bytes     high 32 bits word
              low       4 bytes     low 32 bits word
              0         1 byte      remaining alignment bytes (total is always 3)
              ...
          */ 
          U32 words = cdr(instr); 
          U32 dec; 
          *((*ptr)++) = car(instr) == word_64 ? i_word_64 : i_word_64_push; 
          dec = ((((U32)(*ptr))+1)&3) ? 4-((((U32)(*ptr))+1)&3) : 0; /* number of alignment bytes */
          //dec = ((((U32)(*ptr)))&3) ? 4-((((U32)(*ptr)))&3) : 0; /* number of alignment bytes */
   
          //printf("dec = %d\n",dec); 
   
          *((*ptr)++) = dec;                           /* store the number of alignment bytes */ 
          for (i = 0; i < dec; i++) *((*ptr)++) = 0;   /* write the alignment bytes */ 
          assert((((U32)(*ptr))&3) == 0); 
   
          ((U32 *)(*ptr))[0] = 0;  /* cnt for permanent datum */ 
          ((U32 *)(*ptr))[1] = car(words); 
          words = cdr(words); 
          ((U32 *)(*ptr))[2] = words; 
          *ptr += 12;  /* 3*4 */
          /* write remaining alignement bytes (total is always 3) */ 
          for (i = 0; i < 3 - dec; i++) *((*ptr)++) = 0;
        }
        break; 
   
   
      case word_128: /* instr = (word_128 Cint Cint Cint . Cint) */
      case word_128_push:
        {
          U32 words = cdr(instr);    
          U32 dec; 
          *((*ptr)++) = car(instr) == word_128 ? i_word_128 : i_word_128_push; 
          dec = ((((U32)(*ptr))+1)&3) ? 4-((((U32)(*ptr))+1)&3) : 0; /* number of alignment bytes */
          //dec = ((((U32)(*ptr)))&3) ? 4-((((U32)(*ptr)))&3) : 0; /* number of alignment bytes */
          *((*ptr)++) = dec;                           /* store the number of alignment bytes */ 
          for (i = 0; i < dec; i++) *((*ptr)++) = 0;   /* write the alignment bytes */    
          assert((((U32)(*ptr))&3) == 0); 
          ((U32 *)(*ptr))[0] = 0;  /* cnt for permanent datum */ 
          ((U32 *)(*ptr))[1] = car(words); 
          words = cdr(words); 
          ((U32 *)(*ptr))[2] = car(words); 
          words = cdr(words); 
          ((U32 *)(*ptr))[3] = car(words); 
          words = cdr(words); 
          ((U32 *)(*ptr))[4] = words; 
          *ptr += 20;  /* 5*4 */
          /* write remaining alignement bytes (total is always 3) */ 
          for (i = 0; i < 3 - dec; i++) *((*ptr)++) = 0;   /* write the alignment bytes */ 
        }
        break; 
   
      case load_int_small: /* (load_int_small <bigits>) */
        {
          *((*ptr)++) = i_load_int_small; 
          *(((U32 *)(*ptr))) = (((word32_value(cdr(instr)))<<2)|1);     
                /* the right representation of the small int 'n' is '(|n|<<2)|(sign(n)<<1)|1' 
                   Here it is positive, because the '-' sign is a unary operation. */
          *ptr += sizeof(U32); 
        }
        break; 
   
      case load_int_small_push: /* (load_int_small_push <bigits>) */
        {
          *((*ptr)++) = i_load_int_small_push; 
          *(((U32 *)(*ptr))) = (((word32_value(cdr(instr)))<<2)|1);     
                /* the right representation of the small int 'n' is '(|n|<<2)|(sign(n)<<1)|1' 
                   Here it is positive, because the '-' sign is a unary operation. */
          *ptr += sizeof(U32); 
        }
        break; 
   
      case load_int_big: /* (load_int_big <bigits in basis 256>) (always a positive integer) */
      case load_int_big_push:
        {
          Expr aux; 
          Expr bigits256 = cdr(instr); 
          int n = length(bigits256); 
          U32 dec; 
   
          /* add nul bigits, so as to have a number of bigits (in basis 256) divisible by 4 */
          while (n&3) { n++; bigits256 = cons(new_integer(0),bigits256); }

          /* the instruction */ 
          *((*ptr)++) = car(instr) == load_int_big ? i_load_int_big : i_load_int_big_push; 
          /* compute the number of alignment bytes */
          dec = ((((U32)(*ptr))+1)&3) ? 4-((((U32)(*ptr))+1)&3) : 0; /* number of alignment bytes */
          //dec = ((((U32)(*ptr)))&3) ? 4-((((U32)(*ptr)))&3) : 0; /* number of alignment bytes */
          /* store the number of alignment bytes */ 
          *((*ptr)++) = dec;            
          /* write the alignment bytes */ 
          for (i = 0; i < dec; i++) *((*ptr)++) = 0;   
   
          /* put the counter (aligned on 0 mod 4) */ 
          *(((U32 *)(*ptr))) = 0; /* counter = 0 for permanent datum */ 
          *ptr += sizeof(U32); 
          /* and the number of bigits (in basis 2^32) */
          *(((U32 *)(*ptr))) = n>>2;      /* number of bigits (bytes/4) */ 
          *ptr += sizeof(U32); 
          /* put the bigits (most significant first) */
          while(consp(bigits256))
            {
              aux = first_4(bigits256); 
              bigits256 = cdr4(bigits256); 
              *(((U32 *)(*ptr))) = word32_value(aux);   
              *ptr += sizeof(U32); 
            }
   
          /* write remaining alignement bytes (total is always 3) */ 
          for (i = 0; i < 3 - dec; i++) *((*ptr)++) = 0;   /* write the alignment bytes */ 
        }
        break;    
   
   
      case load_module:    /* (load_module . description) */ 
        {
          *((*ptr)++) = i_load_module; 
          instr = cdr(instr); 
          *(((U32 *)(*ptr))) = length(instr);
          *ptr += sizeof(U32);
          while(consp(instr))
            {
              *((*ptr)++) = (U8)(integer_value(car(instr)));
              instr = cdr(instr); 
            }
        }
        break; 

   case begin_op:
        *((*ptr)++) = i_begin_op; 
    {
     const char * str = NULL;
     *(((U32 *)(*ptr))) = offsets[integer_value(car(cdr(instr)))];
     *ptr += sizeof(U32); 
     str = string_content(cdr(cdr(instr)));
     len = strlen(str);
     if(len > 20)
      len = 20;
     for (i = 0; i < len; i++)
      *((*ptr)++) = str[i];
     for (; i < 21; i++)
      *((*ptr)++) = 0;
    } 
        break; 
    
      case end_op: /* (end_op. label . terminal?) */ 
        *((*ptr)++) = i_end_op; 
        *(((U32 *)(*ptr))) = offsets[integer_value(second(instr))];
        *ptr += sizeof(U32); 
        *((*ptr)++) = (U8)integer_value(cdr2(instr)); 
        break; 
    

#define sc32_item(n,f) case n: *module_flags |= f; \
                               *((*ptr)++) = i_syscall32;\
                               *(((U16 *)(*ptr))) = sc32_##n;\
                               *ptr += sizeof(U16);\
                               *(((U32 *)(*ptr))) = ((cdr(instr))>>1);\
                               *ptr += sizeof(U32);\
                               break; 
        syscall32_list
#undef sc32_item   
      
   
          default:
        internal_error("Cannot translate instruction",instr); 
      }
  else
    switch(instr)
      {
      case no_instr:
        break;    
   
      case initialization_address:     /* initialization_address */ 
        *((*ptr)++) = i_address; 
        *(((U32 *)(*ptr))) = offsets[integer_value(initialization_address_value)];    
        *ptr += sizeof(U32); 
        break; 

      case variables_deletion_address:     /* variables_deletion_address */ 
        *((*ptr)++) = i_address; 
        *(((U32 *)(*ptr))) = offsets[integer_value(variables_deletion_address_value)];    
        *ptr += sizeof(U32); 
        break; 

      case ret_if_zero:
        *((*ptr)++) = i_ret_if_zero; 
        break; 

      case get_var_monitors:
        *((*ptr)++) = i_get_var_monitors; 
        break; 

      case get_mvar_monitors:
        *((*ptr)++) = i_get_mvar_monitors; 
        break; 

      case del_index_direct:
        *((*ptr)++) = i_del_index_direct; 
        break; 

      case del_index_indirect:
        *((*ptr)++) = i_del_index_indirect; 
        break; 

      case indirect_del_ptr:
        *((*ptr)++) = i_indirect_del_ptr; 
        break; 

      case del_function:
        *((*ptr)++) = i_del_function; 
        break; 

      case del_int:
        *((*ptr)++) = i_del_int; 
        break; 

      case mvar_slots_del_function:
        *((*ptr)++) = i_mvar_slots_del_function; 
        break; 

      case mvar_slots_del_int:
        *((*ptr)++) = i_mvar_slots_del_int; 
        break; 

      case indirect_del_function:
        *((*ptr)++) = i_indirect_del_function; 
        break; 

      case indirect_del_int:
        *((*ptr)++) = i_indirect_del_int; 
        break; 

      case indirect_del_conn:
        *((*ptr)++) = i_indirect_del_conn; 
        break; 

      case mvar_slots_del_conn:
        *((*ptr)++) = i_mvar_slots_del_conn; 
        break; 

      case push:
        *((*ptr)++) = i_push;
        break; 

      case push_mvar_length:
        *((*ptr)++) = i_push_mvar_length;
        break; 

      case remove_monitor:
        *((*ptr)++) = i_remove_monitor;
        break; 

      case unlock:
        *((*ptr)++) = i_unlock;
        break; 

      case odd_align:
        if (!(((int)(*ptr))&1))         /* 'ptr' is equal to instruction offset mod 4 */ 
          *((*ptr)++) = i_odd_align;
        break; 

      case nop:
        *((*ptr)++) = i_nop;
        break; 

      case lock:
        *((*ptr)++) = i_lock;
        break; 

      case eq_string:
        *((*ptr)++) = i_eq_string;
        break; 

      case eq_byte_array:
        *((*ptr)++) = i_eq_byte_array;
        break; 

      case eq_int:
        *((*ptr)++) = i_eq_int;
        break; 

      case invalid:
        *((*ptr)++) = i_invalid;
        break; 

      case free_var_seg:
        *((*ptr)++) = i_free_var_seg;
        break; 

      case free_mvar_seg:
        *((*ptr)++) = i_free_mvar_seg;
        break; 

      case create_var:
        *((*ptr)++) = i_create_var;
        break; 

      case create_mvar:
        *((*ptr)++) = i_create_mvar;
        break; 

      case get_vv:
        *((*ptr)++) = i_get_vv;
        break; 

      case get_mvv:
        *((*ptr)++) = i_get_mvv;
        break; 

      case xchg_vv:
        *((*ptr)++) = i_xchg_vv;
        break; 

      case xchg_mvv:
        *((*ptr)++) = i_xchg_mvv;
        break; 

      case pop3:
        *((*ptr)++) = i_pop3;
        break; 

      case pop1:
        *((*ptr)++) = i_pop1;
        break; 

      case swap:
        *((*ptr)++) = i_swap;
        break; 

      case push_eq_data:
        *((*ptr)++) = i_push_eq_data;
        break; 

      case push_before_eq:
        *((*ptr)++) = i_push_before_eq;
        break; 

      case copy_ptr:
        *((*ptr)++) = i_copy_ptr; 
        break; 

      case copy_function:
        *((*ptr)++) = i_copy_function; 
        break; 

      case copy_int:
        *((*ptr)++) = i_copy_int; 
        break; 

      case vcopy_ptr:
        *((*ptr)++) = i_vcopy_ptr; 
        break; 

      case vcopy_int:
        *((*ptr)++) = i_vcopy_int; 
        break; 

      case vcopy_null:
        *((*ptr)++) = i_vcopy_null; 
        break; 

      case index_indirect:
        *((*ptr)++) = i_index_indirect; 
        break; 

      case free_seg_0:
        *((*ptr)++) = i_free_seg_0; 
        break; 

      case free_seg_1_pop2_ret:
        *((*ptr)++) = i_free_seg_1_pop2_ret; 
        break; 

#if 0
   the next 10 transformed into syscalls
      case connect_file_R:
        *((*ptr)++) = i_connect_file_R; 
        break; 

      case connect_file_W:
        *((*ptr)++) = i_connect_file_W; 
        break; 

      case connect_file_RW:
        *((*ptr)++) = i_connect_file_RW; 
        break; 

      case connect_IP_RW:
        *((*ptr)++) = i_connect_IP_RW; 
        break; 

      case read_Word8:
        *((*ptr)++) = i_read_Word8; 
        break; 

      case write_Word8:
        *((*ptr)++) = i_write_Word8; 
        break; 

      case implode:
        *((*ptr)++) = i_implode; 
        break; 

      case explode:
        *((*ptr)++) = i_explode; 
        break; 

      case truncate_to_word8:
        *((*ptr)++) = i_truncate_to_word8; 
        break; 
#endif   

#if 0   
   transformed into a syscall
      case now:
        *((*ptr)++) = i_now; 
        break; 
#endif
   
#if 0
   transformed into a syscall
      case convert_time_from_int:
        *((*ptr)++) = i_convert_time_from_int; 
        break; 
#endif   

#if 0
   transformed into a syscall
      case convert_time_to_int:
        *((*ptr)++) = i_convert_time_to_int; 
        break; 
#endif
   
      case give_up:
        *((*ptr)++) = i_give_up; 
        break; 

      case start_debug_avm:
        *((*ptr)++) = i_start_debug_avm; 
        break; 

      case protect:
        *((*ptr)++) = i_protect; 
        *((*ptr)++) = 0; 
        break; 

      case stop_debug_avm:
        *((*ptr)++) = i_stop_debug_avm; 
        break; 

      case del_ptr:
        *((*ptr)++) = i_del_ptr; 
        break; 

      case mvar_slots_del_ptr:
        *((*ptr)++) = i_mvar_slots_del_ptr; 
        break; 

      case del:
        *((*ptr)++) = i_del; 
        break; 

      case del_conn:
        *((*ptr)++) = i_del_conn; 
        break; 

      case finish:
        *((*ptr)++) = i_finish; 
        break; 

      case get_gvv:
        *((*ptr)++) = i_get_gvv; 
        break; 

      case xchg_gvv:
        *((*ptr)++) = i_xchg_gvv; 
        break; 

#if 0   
   transformed into a syscall
      case byte_array_to_ascii:
        *((*ptr)++) = i_byte_array_to_ascii; 
        break; 
#endif
   
#if 0 
   transformed into a syscall
      case byte_array_to_string:
        *((*ptr)++) = i_byte_array_to_string; 
        break; 
#endif
   
        /* primitive types pseudo-instructions */ 
#define item(n)   case n: *((*ptr)++) = i_##n; break; 
        primitive_types_list
#undef item
#define item(n)   case indirect_##n: *((*ptr)++) = i_indirect_##n; break; 
          primitive_types_list
#undef item

          case type_0:
          *((*ptr)++) = i_type_0; 
        break; 

      case indirect_type_0:
        *((*ptr)++) = i_indirect_type_0; 
        break; 

      case alt_number_indirect:
        *((*ptr)++) = i_alt_number_indirect; 
        break; 


   
        /* system calls */ 

   
#define sc_item(n,f) case n: *module_flags |= f; \
       *((*ptr)++) = i_syscall; *(((U16 *)(*ptr))) = sc_##n;  *ptr += sizeof(U16); break; 
        syscall_list
#undef sc_item   
   
   
   

      case location:
        *((*ptr)++) = 0; 
        *((*ptr)++) = 0; 
        *((*ptr)++) = 0; 
        *((*ptr)++) = 0; 
        break; 

      default:
        internal_error("Cannot translate instruction",instr); 
      } 
}




   /* Given the  'code' of a function, return  the same code, appended to  all local codes
        referenced directly or indirectly from within 'code'.  Of course, this function is
        highly  recursive,  and may  consummate  a  lot of  memory.  It  calls itself  and
        'scode_from_label'. */
   
Expr complete_dynamic_code(Expr code,               /* code to be completed */
                           Expr *already_appended,  /* labels already appended */
                           Expr initialization_address_value,
                           Expr variables_deletion_address_value)
{  
  Expr result = code;
  /* code may be 'nil' */ 

  while (consp(code))
    {
      if (consp(car(code)))
        {
          switch(car(car(code)))
            {

              /* (instr . <addr>) */ 
            case address:
            case indirect_del:
            case indirect_del_mvar:
            case del:
            case indirect_type_large:
            case serialize:
            case unserialize:
            case type_large:
              if (!member(cdr(car(code)),*already_appended))
                {
                  {
                    *already_appended = cons(cdr(car(code)),*already_appended); 
                    result =
                      cons(cons(program,complete_dynamic_code(scode_from_label(car(code),cdr(car(code))),
                                                              already_appended,
                                                              initialization_address_value,
                                                              variables_deletion_address_value)),
                           result); 
                  }
                }
              break; 

            case call: /* (<instr> <addr> . ?) */
            case incr_indirect_del:
            case jmpf:
            case incr_indirect_del_mvar:
              if (!member(second(car(code)),*already_appended))
                {
                  {
                    *already_appended = cons(second(car(code)),*already_appended); 
                    result =
                      cons(cons(program,complete_dynamic_code(scode_from_label(car(code),second(car(code))),
                                                              already_appended,
                                                              initialization_address_value,
                                                              variables_deletion_address_value)),
                           result); 
                  }
                }
              break; 

            case del_mixed: /* (<instr> ? . <addr>) */ 
            case indirect_del_mixed:
            case indirect_type_mixed:
            case type_mixed:
            case del_stack:
            case del_stack_mvar:
              if (!member(cdr2(car(code)),*already_appended))
                {
                  {
                    *already_appended = cons(cdr2(car(code)),*already_appended); 
                    result =
                      cons(cons(program,complete_dynamic_code(scode_from_label(car(code),cdr2(car(code))),
                                                              already_appended,
                                                              initialization_address_value,
                                                              variables_deletion_address_value)),
                           result); 
                  }
                }
              break; 

            case incr_indirect_del_mixed: /* (<instr> ? <addr> . ?) */ 
              if (!member(third(car(code)),*already_appended))
                {
                  {
                    *already_appended = cons(third(car(code)),*already_appended); 
                    result =
                      cons(cons(program,complete_dynamic_code(scode_from_label(car(code),third(car(code))),
                                                              already_appended,
                                                              initialization_address_value,
                                                              variables_deletion_address_value)),
                           result); 
                  }
                }
              break; 

            case del_stack_mixed: /* (<instr> ? ? . <addr>) */ 
              if (!member(cdr3(car(code)),*already_appended))
                {
                  {
                    *already_appended = cons(cdr3(car(code)),*already_appended); 
                    result =
                      cons(cons(program,complete_dynamic_code(scode_from_label(car(code),cdr3(car(code))),
                                                              already_appended,
                                                              initialization_address_value,
                                                              variables_deletion_address_value)),
                           result); 
                  }
                }
              break; 
   
            case put_closure_labels: /* (<instr> <addr> . <addr>) */ 
              {
                if (!member(second(car(code)),*already_appended))
                  {
                    {
                      *already_appended = cons(second(car(code)),*already_appended); 
                      result =
                        cons(cons(program,
                                  complete_dynamic_code(scode_from_label(car(code),second(car(code))),
                                                        already_appended,
                                                        initialization_address_value,
                                                        variables_deletion_address_value)),
                             result); 
                    }
                  }
   
                if (!member(cdr2(car(code)),*already_appended))
                  {
                    {
                      *already_appended = cons(cdr2(car(code)),*already_appended); 
                      result =
                        cons(cons(program,
                                  complete_dynamic_code(scode_from_label(car(code),cdr2(car(code))),
                                                        already_appended,
                                                        initialization_address_value,
                                                        variables_deletion_address_value)),
                             result); 
                    }
                  }
              }
              break;    
            }
        }
   
      code = cdr(code); 
    }  
  return result; 
}