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