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