vm/code_blocks.cpp

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