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   FACTOR_ASSERT(TAG(symbol) == BYTE_ARRAY_TYPE);
 160   symbol_char* name = alien_offset(symbol);
 161   cell sym = ffi_dlsym_raw(d, name);
 162   sym = toc ? FUNCTION_TOC_POINTER(sym) : FUNCTION_CODE_POINTER(sym);
 163   return sym ? sym : undef;
 164 }
 165
 166 cell factor_vm::compute_vm_address(cell arg) {
 167   return (cell)this + untag_fixnum(arg);
 168 }
 169
 170 cell factor_vm::lookup_external_address(relocation_type rel_type,
 171                                         code_block *compiled,
 172                                         array* parameters,
 173                                         cell index) {
 174   switch (rel_type) {
 175     case RT_DLSYM:
 176       return compute_dlsym_address(parameters, index, false);
 177     case RT_THIS:
 178       return compiled->entry_point();
 179     case RT_MEGAMORPHIC_CACHE_HITS:
 180       return (cell)&dispatch_stats.megamorphic_cache_hits;
 181     case RT_VM:
 182       return compute_vm_address(array_nth(parameters, index));
 183     case RT_CARDS_OFFSET:
 184       return cards_offset;
 185     case RT_DECKS_OFFSET:
 186       return decks_offset;
 187 #ifdef FACTOR_PPC
 188     case RT_DLSYM_TOC:
 189       return compute_dlsym_address(parameters, index, true);
 190 #endif
 191     case RT_INLINE_CACHE_MISS:
 192       return (cell)&factor::inline_cache_miss;
 193     case RT_SAFEPOINT:
 194       return code->safepoint_page;
 195     default:
 196       return -1;
 197   }
 198 }
 199
 200 cell factor_vm::compute_external_address(instruction_operand op) {
 201   code_block* compiled = op.compiled;
 202   array* parameters = to_boolean(compiled->parameters)
 203       ? untag<array>(compiled->parameters)
 204       : NULL;
 205   cell idx = op.index;
 206   relocation_type rel_type = op.rel_type();
 207
 208   cell ext_addr = lookup_external_address(rel_type, compiled, parameters, idx);
 209   if (ext_addr == (cell)-1) {
 210     ostringstream ss;
 211     print_obj(ss, compiled->owner);
 212     ss << ": ";
 213     cell arg;
 214     if (rel_type == RT_DLSYM || rel_type == RT_DLSYM_TOC) {
 215       ss << "Bad symbol specifier in compute_external_address";
 216       arg = array_nth(parameters, idx);
 217     } else {
 218       ss << "Bad rel type in compute_external_address";
 219       arg = rel_type;
 220     }
 221     critical_error(ss.str().c_str(), arg);
 222   }
 223   return ext_addr;
 224 }
 225
 226 cell factor_vm::compute_here_address(cell arg, cell offset,
 227                                      code_block* compiled) {
 228   fixnum n = untag_fixnum(arg);
 229   if (n >= 0)
 230     return compiled->entry_point() + offset + n;
 231   return compiled->entry_point() - n;
 232 }
 233
 234 struct initial_code_block_visitor {
 235   factor_vm* parent;
 236   cell literals;
 237   cell literal_index;
 238
 239   initial_code_block_visitor(factor_vm* parent, cell literals)
 240       : parent(parent), literals(literals), literal_index(0) {}
 241
 242   cell next_literal() {
 243     return array_nth(untag<array>(literals), literal_index++);
 244   }
 245
 246   fixnum compute_operand_value(instruction_operand op) {
 247     switch (op.rel_type()) {
 248       case RT_LITERAL:
 249         return next_literal();
 250       case RT_ENTRY_POINT:
 251         return parent->compute_entry_point_address(next_literal());
 252       case RT_ENTRY_POINT_PIC:
 253         return parent->compute_entry_point_pic_address(next_literal());
 254       case RT_ENTRY_POINT_PIC_TAIL:
 255         return parent->compute_entry_point_pic_tail_address(next_literal());
 256       case RT_HERE:
 257         return parent->compute_here_address(
 258             next_literal(), op.rel_offset(), op.compiled);
 259       case RT_UNTAGGED:
 260         return untag_fixnum(next_literal());
 261       default:
 262         return parent->compute_external_address(op);
 263     }
 264   }
 265
 266   void operator()(instruction_operand op) {
 267     op.store_value(compute_operand_value(op));
 268   }
 269 };
 270
 271 /* Perform all fixups on a code block */
 272 void factor_vm::initialize_code_block(code_block* compiled, cell literals) {
 273   initial_code_block_visitor visitor(this, literals);
 274   compiled->each_instruction_operand(visitor);
 275   compiled->flush_icache();
 276
 277   /* next time we do a minor GC, we have to trace this code block, since
 278      the newly-installed instruction operands might point to literals in
 279      nursery or aging */
 280   code->write_barrier(compiled);
 281 }
 282
 283 void factor_vm::initialize_code_block(code_block* compiled) {
 284   std::map<code_block*, cell>::iterator iter =
 285       code->uninitialized_blocks.find(compiled);
 286   initialize_code_block(compiled, iter->second);
 287   code->uninitialized_blocks.erase(iter);
 288 }
 289
 290 /* Fixup labels. This is done at compile time, not image load time */
 291 void factor_vm::fixup_labels(array* labels, code_block* compiled) {
 292   cell size = array_capacity(labels);
 293
 294   for (cell i = 0; i < size; i += 3) {
 295     relocation_class rel_class =
 296         (relocation_class) untag_fixnum(array_nth(labels, i));
 297     cell offset = untag_fixnum(array_nth(labels, i + 1));
 298     cell target = untag_fixnum(array_nth(labels, i + 2));
 299
 300     relocation_entry new_entry(RT_HERE, rel_class, offset);
 301
 302     instruction_operand op(new_entry, compiled, 0);
 303     op.store_value(target + compiled->entry_point());
 304   }
 305 }
 306
 307 /* Might GC */
 308 /* Allocates memory */
 309 code_block* factor_vm::allot_code_block(cell size, code_block_type type) {
 310   code_block* block = code->allocator->allot(size + sizeof(code_block));
 311
 312   /* If allocation failed, do a full GC and compact the code heap.
 313      A full GC that occurs as a result of the data heap filling up does not
 314      trigger a compaction. This setup ensures that most GCs do not compact
 315      the code heap, but if the code fills up, it probably means it will be
 316      fragmented after GC anyway, so its best to compact. */
 317   if (block == NULL) {
 318     primitive_compact_gc();
 319     block = code->allocator->allot(size + sizeof(code_block));
 320
 321     /* Insufficient room even after code GC, give up */
 322     if (block == NULL) {
 323       std::cout << "Code heap used: " << code->allocator->occupied_space()
 324                 << "\n";
 325       std::cout << "Code heap free: " << code->allocator->free_space() << "\n";
 326       fatal_error("Out of memory in add-compiled-block", 0);
 327     }
 328   }
 329
 330   block->set_type(type);
 331   return block;
 332 }
 333
 334 /* Might GC */
 335 /* Allocates memory */
 336 code_block* factor_vm::add_code_block(code_block_type type, cell code_,
 337                                       cell labels_, cell owner_,
 338                                       cell relocation_, cell parameters_,
 339                                       cell literals_,
 340                                       cell frame_size_untagged) {
 341   data_root<byte_array> code(code_, this);
 342   data_root<object> labels(labels_, this);
 343   data_root<object> owner(owner_, this);
 344   data_root<byte_array> relocation(relocation_, this);
 345   data_root<array> parameters(parameters_, this);
 346   data_root<array> literals(literals_, this);
 347
 348   cell code_length = array_capacity(code.untagged());
 349   code_block* compiled = allot_code_block(code_length, type);
 350
 351   compiled->owner = owner.value();
 352
 353   /* slight space optimization */
 354   if (relocation.type() == BYTE_ARRAY_TYPE &&
 355       array_capacity(relocation.untagged()) == 0)
 356     compiled->relocation = false_object;
 357   else
 358     compiled->relocation = relocation.value();
 359
 360   if (parameters.type() == ARRAY_TYPE &&
 361       array_capacity(parameters.untagged()) == 0)
 362     compiled->parameters = false_object;
 363   else
 364     compiled->parameters = parameters.value();
 365
 366   /* code */
 367   memcpy(compiled + 1, code.untagged() + 1, code_length);
 368
 369   /* fixup labels */
 370   if (to_boolean(labels.value()))
 371     fixup_labels(labels.as<array>().untagged(), compiled);
 372
 373   compiled->set_stack_frame_size(frame_size_untagged);
 374
 375   /* Once we are ready, fill in literal and word references in this code
 376      block's instruction operands. In most cases this is done right after this
 377      method returns, except when compiling words with the non-optimizing
 378      compiler at the beginning of bootstrap */
 379   this->code->uninitialized_blocks.insert(
 380       std::make_pair(compiled, literals.value()));
 381   this->code->all_blocks.insert((cell)compiled);
 382
 383   /* next time we do a minor GC, we have to trace this code block, since
 384      the fields of the code_block struct might point into nursery or aging */
 385   this->code->write_barrier(compiled);
 386
 387   return compiled;
 388 }
 389
 390 /* References to undefined symbols are patched up to call this function on
 391    image load. It finds the symbol and library, and throws an error. */
 392 void factor_vm::undefined_symbol() {
 393   cell frame = ctx->callstack_top;
 394   cell return_address = *(cell*)frame;
 395   code_block* compiled = code->code_block_for_address(return_address);
 396
 397   /* Find the RT_DLSYM relocation nearest to the given return
 398      address. */
 399   cell symbol = false_object;
 400   cell library = false_object;
 401
 402   auto find_symbol_at_address_visitor = [&](instruction_operand op) {
 403     if (op.rel_type() == RT_DLSYM && op.pointer <= return_address) {
 404       array* parameters = untag<array>(compiled->parameters);
 405       cell index = op.index;
 406       symbol = array_nth(parameters, index);
 407       library = array_nth(parameters, index + 1);
 408     }
 409   };
 410   compiled->each_instruction_operand(find_symbol_at_address_visitor);
 411
 412   if (!to_boolean(symbol))
 413     critical_error("Can't find RT_DLSYM at return address", return_address);
 414   else
 415     general_error(ERROR_UNDEFINED_SYMBOL, symbol, library);
 416 }
 417
 418 void undefined_symbol() {
 419   return current_vm()->undefined_symbol();
 420 }
 421 }