vm/code_blocks.cpp

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