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