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