vm/code_blocks.cpp

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