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