vm/code_blocks.cpp

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