vm/code_blocks.cpp

   1 #include "master.hpp"
   2
   3 namespace factor
   4 {
   5
   6 cell factor_vm::compute_entry_point_address(cell obj)
   7 {
   8         switch(tagged<object>(obj).type())
   9         {
  10         case WORD_TYPE:
  11                 return (cell)untag<word>(obj)->entry_point;
  12         case QUOTATION_TYPE:
  13                 return (cell)untag<quotation>(obj)->entry_point;
  14         default:
  15                 critical_error("Expected word or quotation",obj);
  16                 return 0;
  17         }
  18 }
  19
  20 cell factor_vm::compute_entry_point_pic_address(word *w, cell tagged_quot)
  21 {
  22         if(!to_boolean(tagged_quot) || max_pic_size == 0)
  23                 return (cell)w->entry_point;
  24         else
  25         {
  26                 quotation *quot = untag<quotation>(tagged_quot);
  27                 if(quot_compiled_p(quot))
  28                         return (cell)quot->entry_point;
  29                 else
  30                         return (cell)w->entry_point;
  31         }
  32 }
  33
  34 cell factor_vm::compute_entry_point_pic_address(cell w_)
  35 {
  36         tagged<word> w(w_);
  37         return compute_entry_point_pic_address(w.untagged(),w->pic_def);
  38 }
  39
  40 cell factor_vm::compute_entry_point_pic_tail_address(cell w_)
  41 {
  42         tagged<word> w(w_);
  43         return compute_entry_point_pic_address(w.untagged(),w->pic_tail_def);
  44 }
  45
  46 cell factor_vm::code_block_owner(code_block *compiled)
  47 {
  48         tagged<object> owner(compiled->owner);
  49
  50         /* Cold generic word call sites point to quotations that call the
  51         inline-cache-miss and inline-cache-miss-tail primitives. */
  52         if(owner.type_p(QUOTATION_TYPE))
  53         {
  54                 tagged<quotation> quot(owner.as<quotation>());
  55                 tagged<array> elements(quot->array);
  56 #ifdef FACTOR_DEBUG
  57                 assert(array_capacity(elements.untagged()) == 5);
  58                 assert(array_nth(elements.untagged(),4) == special_objects[PIC_MISS_WORD]
  59                         || array_nth(elements.untagged(),4) == special_objects[PIC_MISS_TAIL_WORD]);
  60 #endif
  61                 tagged<wrapper> word_wrapper(array_nth(elements.untagged(),0));
  62                 return word_wrapper->object;
  63         }
  64         else
  65                 return compiled->owner;
  66 }
  67
  68 struct update_word_references_relocation_visitor {
  69         factor_vm *parent;
  70         bool reset_inline_caches;
  71
  72         update_word_references_relocation_visitor(
  73                 factor_vm *parent_,
  74                 bool reset_inline_caches_) :
  75                 parent(parent_),
  76                 reset_inline_caches(reset_inline_caches_) {}
  77
  78         void operator()(instruction_operand op)
  79         {
  80                 switch(op.rel_type())
  81                 {
  82                 case RT_ENTRY_POINT:
  83                         {
  84                                 code_block *compiled = op.load_code_block();
  85                                 cell owner = compiled->owner;
  86                                 if(to_boolean(owner))
  87                                         op.store_value(parent->compute_entry_point_address(owner));
  88                                 break;
  89                         }
  90                 case RT_ENTRY_POINT_PIC:
  91                         {
  92                                 code_block *compiled = op.load_code_block();
  93                                 if(reset_inline_caches || !compiled->pic_p())
  94                                 {
  95                                         cell owner = parent->code_block_owner(compiled);
  96                                         if(to_boolean(owner))
  97                                                 op.store_value(parent->compute_entry_point_pic_address(owner));
  98                                 }
  99                                 break;
 100                         }
 101                 case RT_ENTRY_POINT_PIC_TAIL:
 102                         {
 103                                 code_block *compiled = op.load_code_block();
 104                                 if(reset_inline_caches || !compiled->pic_p())
 105                                 {
 106                                         cell owner = parent->code_block_owner(compiled);
 107                                         if(to_boolean(owner))
 108                                                 op.store_value(parent->compute_entry_point_pic_tail_address(owner));
 109                                 }
 110                                 break;
 111                         }
 112                 default:
 113                         break;
 114                 }
 115         }
 116 };
 117
 118 /* Relocate new code blocks completely; updating references to literals,
 119 dlsyms, and words. For all other words in the code heap, we only need
 120 to update references to other words, without worrying about literals
 121 or dlsyms. */
 122 void factor_vm::update_word_references(code_block *compiled, bool reset_inline_caches)
 123 {
 124         if(code->uninitialized_p(compiled))
 125                 initialize_code_block(compiled);
 126         /* update_word_references() is always applied to every block in
 127            the code heap. Since it resets all call sites to point to
 128            their canonical entry point (cold entry point for non-tail calls,
 129            standard entry point for tail calls), it means that no PICs
 130            are referenced after this is done. So instead of polluting
 131            the code heap with dead PICs that will be freed on the next
 132            GC, we add them to the free list immediately. */
 133         else if(reset_inline_caches && compiled->pic_p())
 134                 code->free(compiled);
 135         else
 136         {
 137                 update_word_references_relocation_visitor visitor(this,reset_inline_caches);
 138                 compiled->each_instruction_operand(visitor);
 139                 compiled->flush_icache();
 140         }
 141 }
 142
 143 /* References to undefined symbols are patched up to call this function on
 144 image load */
 145 void factor_vm::undefined_symbol()
 146 {
 147         general_error(ERROR_UNDEFINED_SYMBOL,false_object,false_object);
 148 }
 149
 150 void undefined_symbol()
 151 {
 152         return current_vm()->undefined_symbol();
 153 }
 154
 155 /* Look up an external library symbol referenced by a compiled code block */
 156 cell factor_vm::compute_dlsym_address(array *literals, cell index)
 157 {
 158         cell symbol = array_nth(literals,index);
 159         cell library = array_nth(literals,index + 1);
 160
 161         dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
 162
 163         if(d != NULL && !d->handle)
 164                 return (cell)factor::undefined_symbol;
 165
 166         switch(tagged<object>(symbol).type())
 167         {
 168         case BYTE_ARRAY_TYPE:
 169                 {
 170                         symbol_char *name = alien_offset(symbol);
 171                         void *sym = ffi_dlsym(d,name);
 172
 173                         if(sym)
 174                                 return (cell)sym;
 175                         else
 176                                 return (cell)factor::undefined_symbol;
 177                 }
 178         case ARRAY_TYPE:
 179                 {
 180                         array *names = untag<array>(symbol);
 181                         for(cell i = 0; i < array_capacity(names); i++)
 182                         {
 183                                 symbol_char *name = alien_offset(array_nth(names,i));
 184                                 void *sym = ffi_dlsym(d,name);
 185
 186                                 if(sym)
 187                                         return (cell)sym;
 188                         }
 189                         return (cell)factor::undefined_symbol;
 190                 }
 191         default:
 192                 critical_error("Bad symbol specifier",symbol);
 193                 return (cell)factor::undefined_symbol;
 194         }
 195 }
 196
 197 cell factor_vm::compute_vm_address(cell arg)
 198 {
 199         return (cell)this + untag_fixnum(arg);
 200 }
 201
 202 void factor_vm::store_external_address(instruction_operand op)
 203 {
 204         code_block *compiled = op.parent_code_block();
 205         array *parameters = (to_boolean(compiled->parameters) ? untag<array>(compiled->parameters) : NULL);
 206         cell index = op.parameter_index();
 207
 208         switch(op.rel_type())
 209         {
 210         case RT_DLSYM:
 211                 op.store_value(compute_dlsym_address(parameters,index));
 212                 break;
 213         case RT_THIS:
 214                 op.store_value((cell)compiled->entry_point());
 215                 break;
 216         case RT_MEGAMORPHIC_CACHE_HITS:
 217                 op.store_value((cell)&dispatch_stats.megamorphic_cache_hits);
 218                 break;
 219         case RT_VM:
 220                 op.store_value(compute_vm_address(array_nth(parameters,index)));
 221                 break;
 222         case RT_CARDS_OFFSET:
 223                 op.store_value(cards_offset);
 224                 break;
 225         case RT_DECKS_OFFSET:
 226                 op.store_value(decks_offset);
 227                 break;
 228         default:
 229                 critical_error("Bad rel type",op.rel_type());
 230                 break;
 231         }
 232 }
 233
 234 cell factor_vm::compute_here_address(cell arg, cell offset, code_block *compiled)
 235 {
 236         fixnum n = untag_fixnum(arg);
 237         if(n >= 0)
 238                 return (cell)compiled->entry_point() + offset + n;
 239         else
 240                 return (cell)compiled->entry_point() - n;
 241 }
 242
 243 struct initial_code_block_visitor {
 244         factor_vm *parent;
 245         cell literals;
 246         cell literal_index;
 247
 248         explicit initial_code_block_visitor(factor_vm *parent_, cell literals_)
 249                 : parent(parent_), literals(literals_), literal_index(0) {}
 250
 251         cell next_literal()
 252         {
 253                 return array_nth(untag<array>(literals),literal_index++);
 254         }
 255
 256         void operator()(instruction_operand op)
 257         {
 258                 switch(op.rel_type())
 259                 {
 260                 case RT_LITERAL:
 261                         op.store_value(next_literal());
 262                         break;
 263                 case RT_ENTRY_POINT:
 264                         op.store_value(parent->compute_entry_point_address(next_literal()));
 265                         break;
 266                 case RT_ENTRY_POINT_PIC:
 267                         op.store_value(parent->compute_entry_point_pic_address(next_literal()));
 268                         break;
 269                 case RT_ENTRY_POINT_PIC_TAIL:
 270                         op.store_value(parent->compute_entry_point_pic_tail_address(next_literal()));
 271                         break;
 272                 case RT_HERE:
 273                         op.store_value(parent->compute_here_address(next_literal(),op.rel_offset(),op.parent_code_block()));
 274                         break;
 275                 case RT_UNTAGGED:
 276                         op.store_value(untag_fixnum(next_literal()));
 277                         break;
 278                 default:
 279                         parent->store_external_address(op);
 280                         break;
 281                 }
 282         }
 283 };
 284
 285 /* Perform all fixups on a code block */
 286 void factor_vm::initialize_code_block(code_block *compiled, cell literals)
 287 {
 288         initial_code_block_visitor visitor(this,literals);
 289         compiled->each_instruction_operand(visitor);
 290         compiled->flush_icache();
 291
 292         /* next time we do a minor GC, we have to trace this code block, since
 293         the newly-installed instruction operands might point to literals in
 294         nursery or aging */
 295         code->write_barrier(compiled);
 296 }
 297
 298 void factor_vm::initialize_code_block(code_block *compiled)
 299 {
 300         std::map<code_block *,cell>::iterator iter = code->uninitialized_blocks.find(compiled);
 301         initialize_code_block(compiled,iter->second);
 302         code->uninitialized_blocks.erase(iter);
 303 }
 304
 305 /* Fixup labels. This is done at compile time, not image load time */
 306 void factor_vm::fixup_labels(array *labels, code_block *compiled)
 307 {
 308         cell size = array_capacity(labels);
 309
 310         for(cell i = 0; i < size; i += 3)
 311         {
 312                 relocation_class rel_class = (relocation_class)untag_fixnum(array_nth(labels,i));
 313                 cell offset = untag_fixnum(array_nth(labels,i + 1));
 314                 cell target = untag_fixnum(array_nth(labels,i + 2));
 315
 316                 relocation_entry new_entry(RT_HERE,rel_class,offset);
 317
 318                 instruction_operand op(new_entry,compiled,0);
 319                 op.store_value(target + (cell)compiled->entry_point());
 320         }
 321 }
 322
 323 /* Might GC */
 324 code_block *factor_vm::allot_code_block(cell size, code_block_type type)
 325 {
 326         code_block *block = code->allocator->allot(size + sizeof(code_block));
 327
 328         /* If allocation failed, do a full GC and compact the code heap.
 329         A full GC that occurs as a result of the data heap filling up does not
 330         trigger a compaction. This setup ensures that most GCs do not compact
 331         the code heap, but if the code fills up, it probably means it will be
 332         fragmented after GC anyway, so its best to compact. */
 333         if(block == NULL)
 334         {
 335                 primitive_compact_gc();
 336                 block = code->allocator->allot(size + sizeof(code_block));
 337
 338                 /* Insufficient room even after code GC, give up */
 339                 if(block == NULL)
 340                 {
 341                         std::cout << "Code heap used: " << code->allocator->occupied_space() << "\n";
 342                         std::cout << "Code heap free: " << code->allocator->free_space() << "\n";
 343                         fatal_error("Out of memory in add-compiled-block",0);
 344                 }
 345         }
 346
 347         block->set_type(type);
 348         return block;
 349 }
 350
 351 /* Might GC */
 352 code_block *factor_vm::add_code_block(code_block_type type, cell code_, cell labels_, cell owner_, cell relocation_, cell parameters_, cell literals_)
 353 {
 354         data_root<byte_array> code(code_,this);
 355         data_root<object> labels(labels_,this);
 356         data_root<object> owner(owner_,this);
 357         data_root<byte_array> relocation(relocation_,this);
 358         data_root<array> parameters(parameters_,this);
 359         data_root<array> literals(literals_,this);
 360
 361         cell code_length = array_capacity(code.untagged());
 362         code_block *compiled = allot_code_block(code_length,type);
 363
 364         compiled->owner = owner.value();
 365
 366         /* slight space optimization */
 367         if(relocation.type() == BYTE_ARRAY_TYPE && array_capacity(relocation.untagged()) == 0)
 368                 compiled->relocation = false_object;
 369         else
 370                 compiled->relocation = relocation.value();
 371
 372         if(parameters.type() == ARRAY_TYPE && array_capacity(parameters.untagged()) == 0)
 373                 compiled->parameters = false_object;
 374         else
 375                 compiled->parameters = parameters.value();
 376
 377         /* code */
 378         memcpy(compiled + 1,code.untagged() + 1,code_length);
 379
 380         /* fixup labels */
 381         if(to_boolean(labels.value()))
 382                 fixup_labels(labels.as<array>().untagged(),compiled);
 383
 384         /* Once we are ready, fill in literal and word references in this code
 385         block's instruction operands. In most cases this is done right after this
 386         method returns, except when compiling words with the non-optimizing
 387         compiler at the beginning of bootstrap */
 388         this->code->uninitialized_blocks.insert(std::make_pair(compiled,literals.value()));
 389
 390         /* next time we do a minor GC, we have to trace this code block, since
 391         the fields of the code_block struct might point into nursery or aging */
 392         this->code->write_barrier(compiled);
 393
 394         return compiled;
 395 }
 396
 397 }