vm/code_blocks.cpp

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