Anubis / Anubis

/* 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); 
   
  //debug(instr); 
  //debug(addr); 
   
  switch(e->sort) 
    {
    case labs_closure:         
      result = closure_codes[e->index].offline_code;
      break; 
   
    case labs_compiled_op:     
      result = compiled_ops[e->index].offline_code;
      break;
   
    case labs_del_code:        
      result = del_codes[e->index].offline_code;
      break; 
   
    case labs_mctxt_del_code:  
      result = mctxt_del_codes[e->index].offline_code;
      break;
   
    case labs_implem:          
      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; 
    }  
  assert(result != nil); 
  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:
      case unstore_copy_ptr:
      case unstore_copy_function:
      case alloc:
      case increment_del:
      case increment_eq:
      case copy_mixed:
      case vcopy_mixed:
      case copy_stack_ptr:
      case copy_stack_function:
      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:                
 return 2; 

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

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

 //      case load:
      case put_micro_copy_mixed:
      case load_int32:       
      case peek:
      case print_string:
      case print_int32:
      case address:             
      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 push_addr:
      case del_stack_ptr:
      case del_stack_conn:
      case del_stack_function:
      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 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:
 return 6; 

      case select_index_direct:
      case jmp_neq_indexes_mixed:
 return 7; 

      case del_stack:
      case load_float:
      case del_stack_var:
      case del_stack_mvar:
      case micro_peek: 
      case put_closure_labels:
 return 9; 

      case del_stack_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 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:
 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; 
        }
      }
  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 del_function:
      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 pop2:
      case pop1:
      case pop3:
      case swap:
      case push_eq_data:
      case push_before_eq:
      case copy:
      case copy_ptr:
      case copy_function:
      case vcopy_ptr:
      case vcopy_function:
      case vcopy_null:
      case index_indirect:
      case free_seg_0:
      case free_seg_1:
      case eq_string:
      case eq_byte_array:
      case give_up:
      case start_debug_avm:
      case stop_debug_avm:
      case del:
      case del_ptr:
      case del_conn:
      case mvar_slots_del_conn:
      case mvar_slots_del_ptr:
      case mvar_slots_del_function:
      case finish:
      case get_gvv:
      case xchg_gvv:
      case do_alert:
      case type_0:
      case unlock:
      case lock:
      case indirect_type_0:
   /* 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) */ 
   
      case connect_file_R:
      case connect_file_W:
      case connect_file_RW:
      case connect_IP_RW:
      case read_Int8:
      case read_Int32:
      case read_function:
      case write_Int8:
      case write_Int32:
      case write_function:
      case implode:
      case explode:
      case int8_to_int32:
      case truncate_to_int8:
      case now:
      case convert_time_from_int:
      case convert_time_to_int:
      case pending_event:
      case listener:
      case accept_connection:
      case listener_shutdown:
      case listener_is_down:
      case byte_array_to_ascii:
      case byte_array_to_string:
      case dns:
      case write_file:
      case read_file:
      case file_size:
      case byte_array_length:
      case sha1_hash:
      case get_file_mode:
      case set_file_mode:
      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; 
}
   
   
   
void translate_instruction(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 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_inline . 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> . [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: /* (unstore_copy . <offset>) */ 
   *((*ptr)++) = i_unstore_copy;
   *((*ptr)++) = integer_value(cdr(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_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_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 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 load_int32:     /* (load_int32 . <Cint>) */ 
 *((*ptr)++) = i_load_int32; 
 *(((U32 *)(*ptr))++) = cdr(instr); /* this is a <Cint> */ 
 break; 

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

      case push_addr:   /* (push_addr . a) */ 
        *((*ptr)++) = i_push_addr; 
 *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))]; 
 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))]); 
 break;

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

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

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

      case create_vars: /* (create_vars . <number of variables>) */ 
 *((*ptr)++) = i_create_vars; 
 *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
 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)); 
        {
          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)); 
        //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)); 
        {
          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)); 
        {
          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)); 
        {
          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)); 
        {
          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)); 
        {
          aux = cdr(instr); 
          while (consp(aux))
            {
         *((*ptr)++) = (U8)integer_value(car(aux)); 
              aux = cdr(aux); 
            }
        }
        break; 
   
      case string:     /* (string . <index>) */ 
 *((*ptr)++) = i_string; 
 *(((U32 *)(*ptr))++) = len = 
     strlen(string_content(compiled_strings[integer_value(cdr(instr))].string));
        *(((U32 *)(*ptr))++) = 0; /* null counter => permanent string */
 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(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))];
 break; 

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

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

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

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

      case del_mixed:     /* (del_mixed <mask> . <address>) */ 
 *((*ptr)++) = i_del_mixed; 
 *((*ptr)++) = integer_value(second(instr)); 
 *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
 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))];
 break; 

      case type_mixed:     /* (type_mixed <mask> . <address>) */ 
 *((*ptr)++) = i_type_mixed; 
 *((*ptr)++) = integer_value(second(instr)); 
 *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
 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))];
 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))];
 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 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))];
 break; 

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

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

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

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

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

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

      case jmp_neq_byte_array:     /* (jmp_neq_byte_array . <address>) */ 
 *((*ptr)++) = i_jmp_neq_byte_array; 
 *(((U32 *)(*ptr))++) = offsets[integer_value(cdr(instr))];
 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))];
 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))];
 }
 break; 

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

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

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

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

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

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

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

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

      case print_string:      /* (print_string . <depth>) */ 
 *((*ptr)++) = i_print_string; 
 *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
 break; 

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

      case del_stack_function: /* (del_stack_function . <depth>) */ 
 *((*ptr)++) = i_del_stack_function; 
 *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
 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));
 break; 

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

      case print_int32:      /* (print_int32 . <depth>) */ 
 *((*ptr)++) = i_print_int32; 
 *(((U32 *)(*ptr))++) = integer_value(cdr(instr));
 break; 

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

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

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

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

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

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

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

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

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

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

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

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

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

      case start: /* (start <depth> . <addr>) */ 
 *((*ptr)++) = i_start; 
 *((*ptr)++) = integer_value(second(instr));
 *(((U32 *)(*ptr))++) = offsets[integer_value(cdr2(instr))];
 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))]; 
       instr = cdr(instr); 
     }
 } 
 break; 

      case del_gv:     /* (del_gv . index) */ 
 *((*ptr)++) = i_del_gv; 
 *(((U32 *)(*ptr))++) = integer_value(cdr(instr));       
 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))]; 
       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))]; 
       instr = cdr(instr); 
     }
 } 
 break; 

      case load_module:    /* (load_module . description) */ 
        {
   *((*ptr)++) = i_load_module; 
   instr = cdr(instr); 
          *(((U32 *)(*ptr))++) = length(instr);
          while(consp(instr))
            {
              *((*ptr)++) = (U8)(integer_value(car(instr)));
              instr = cdr(instr); 
            }
        }
        break; 
   
      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)];    
 break; 

      case variables_deletion_address:     /* variables_deletion_address */ 
 *((*ptr)++) = i_address; 
 *(((U32 *)(*ptr))++) = offsets[integer_value(variables_deletion_address_value)];    
 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 mvar_slots_del_function:
 *((*ptr)++) = i_mvar_slots_del_function; 
 break; 

      case indirect_del_function:
 *((*ptr)++) = i_indirect_del_function; 
 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 lock:
 *((*ptr)++) = i_lock;
 break; 

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

      case eq_byte_array:
 *((*ptr)++) = i_eq_byte_array;
 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 pop2:
 *((*ptr)++) = i_pop2;
 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)++) = i_copy; 
 break; 

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

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

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

      case vcopy_function:
 *((*ptr)++) = i_vcopy_function; 
 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:
 *((*ptr)++) = i_free_seg_1; 
 break; 

      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_Int8:
 *((*ptr)++) = i_read_Int8; 
 break; 

      case read_Int32:
 *((*ptr)++) = i_read_Int32; 
 break; 

      case read_function:
 *((*ptr)++) = i_read_function; 
 break; 

      case write_Int8:
 *((*ptr)++) = i_write_Int8; 
 break; 

      case write_Int32:
 *((*ptr)++) = i_write_Int32; 
 break; 

      case write_function:
 *((*ptr)++) = i_write_function; 
 break; 

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

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

      case int8_to_int32:
 *((*ptr)++) = i_int8_to_int32; 
 break; 

      case truncate_to_int8:
 *((*ptr)++) = i_truncate_to_int8; 
 break; 

      case now:
 *((*ptr)++) = i_now; 
 break; 

      case convert_time_from_int:
 *((*ptr)++) = i_convert_time_from_int; 
 break; 

      case convert_time_to_int:
 *((*ptr)++) = i_convert_time_to_int; 
 break; 

      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 pending_event:
 *((*ptr)++) = i_pending_event; 
 break; 

      case listener:
 *((*ptr)++) = i_listener; 
 break; 

      case accept_connection:
 *((*ptr)++) = i_accept_connection; 
 break; 

      case listener_shutdown:
 *((*ptr)++) = i_listener_shutdown; 
 break; 

      case listener_is_down:
 *((*ptr)++) = i_listener_is_down; 
 break; 

      case do_alert:
 *((*ptr)++) = i_do_alert; 
 break; 

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

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

      case byte_array_to_ascii:
 *((*ptr)++) = i_byte_array_to_ascii; 
 break; 

      case byte_array_to_string:
 *((*ptr)++) = i_byte_array_to_string; 
 break; 

 /* 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 dns:
 *((*ptr)++) = i_dns; 
      break; 

      case write_file:
 *((*ptr)++) = i_write_file; 
      break; 

      case read_file:
 *((*ptr)++) = i_read_file; 
      break; 

      case file_size:
 *((*ptr)++) = i_file_size; 
      break; 

      case byte_array_length:
 *((*ptr)++) = i_byte_array_length; 
      break; 

      case sha1_hash:
 *((*ptr)++) = i_sha1_hash; 
      break; 

      case get_file_mode:
 *((*ptr)++) = i_get_file_mode; 
      break; 

      case set_file_mode:
 *((*ptr)++) = i_set_file_mode; 
      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; 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> . ?) */
              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 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; 
}