vm/code_blocks.cpp

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