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                 assert(array_capacity(elements.untagged()) == 5);
  58                 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         default:
 276                 critical_error("Bad rel type in store_external_address()",op.rel_type());
 277                 break;
 278         }
 279 }
 280
 281 cell factor_vm::compute_here_address(cell arg, cell offset, code_block *compiled)
 282 {
 283         fixnum n = untag_fixnum(arg);
 284         if(n >= 0)
 285                 return (cell)compiled->entry_point() + offset + n;
 286         else
 287                 return (cell)compiled->entry_point() - n;
 288 }
 289
 290 struct initial_code_block_visitor {
 291         factor_vm *parent;
 292         cell literals;
 293         cell literal_index;
 294
 295         explicit initial_code_block_visitor(factor_vm *parent_, cell literals_)
 296                 : parent(parent_), literals(literals_), literal_index(0) {}
 297
 298         cell next_literal()
 299         {
 300                 return array_nth(untag<array>(literals),literal_index++);
 301         }
 302
 303         void operator()(instruction_operand op)
 304         {
 305                 switch(op.rel_type())
 306                 {
 307                 case RT_LITERAL:
 308                         op.store_value(next_literal());
 309                         break;
 310                 case RT_ENTRY_POINT:
 311                         op.store_value(parent->compute_entry_point_address(next_literal()));
 312                         break;
 313                 case RT_ENTRY_POINT_PIC:
 314                         op.store_value(parent->compute_entry_point_pic_address(next_literal()));
 315                         break;
 316                 case RT_ENTRY_POINT_PIC_TAIL:
 317                         op.store_value(parent->compute_entry_point_pic_tail_address(next_literal()));
 318                         break;
 319                 case RT_HERE:
 320                         op.store_value(parent->compute_here_address(next_literal(),op.rel_offset(),op.compiled));
 321                         break;
 322                 case RT_UNTAGGED:
 323                         op.store_value(untag_fixnum(next_literal()));
 324                         break;
 325                 default:
 326                         parent->store_external_address(op);
 327                         break;
 328                 }
 329         }
 330 };
 331
 332 /* Perform all fixups on a code block */
 333 void factor_vm::initialize_code_block(code_block *compiled, cell literals)
 334 {
 335         initial_code_block_visitor visitor(this,literals);
 336         compiled->each_instruction_operand(visitor);
 337         compiled->flush_icache();
 338
 339         /* next time we do a minor GC, we have to trace this code block, since
 340         the newly-installed instruction operands might point to literals in
 341         nursery or aging */
 342         code->write_barrier(compiled);
 343 }
 344
 345 void factor_vm::initialize_code_block(code_block *compiled)
 346 {
 347         std::map<code_block *,cell>::iterator iter = code->uninitialized_blocks.find(compiled);
 348         initialize_code_block(compiled,iter->second);
 349         code->uninitialized_blocks.erase(iter);
 350 }
 351
 352 /* Fixup labels. This is done at compile time, not image load time */
 353 void factor_vm::fixup_labels(array *labels, code_block *compiled)
 354 {
 355         cell size = array_capacity(labels);
 356
 357         for(cell i = 0; i < size; i += 3)
 358         {
 359                 relocation_class rel_class = (relocation_class)untag_fixnum(array_nth(labels,i));
 360                 cell offset = untag_fixnum(array_nth(labels,i + 1));
 361                 cell target = untag_fixnum(array_nth(labels,i + 2));
 362
 363                 relocation_entry new_entry(RT_HERE,rel_class,offset);
 364
 365                 instruction_operand op(new_entry,compiled,0);
 366                 op.store_value(target + (cell)compiled->entry_point());
 367         }
 368 }
 369
 370 /* Might GC */
 371 code_block *factor_vm::allot_code_block(cell size, code_block_type type)
 372 {
 373         code_block *block = code->allocator->allot(size + sizeof(code_block));
 374
 375         /* If allocation failed, do a full GC and compact the code heap.
 376         A full GC that occurs as a result of the data heap filling up does not
 377         trigger a compaction. This setup ensures that most GCs do not compact
 378         the code heap, but if the code fills up, it probably means it will be
 379         fragmented after GC anyway, so its best to compact. */
 380         if(block == NULL)
 381         {
 382                 primitive_compact_gc();
 383                 block = code->allocator->allot(size + sizeof(code_block));
 384
 385                 /* Insufficient room even after code GC, give up */
 386                 if(block == NULL)
 387                 {
 388                         std::cout << "Code heap used: " << code->allocator->occupied_space() << "\n";
 389                         std::cout << "Code heap free: " << code->allocator->free_space() << "\n";
 390                         fatal_error("Out of memory in add-compiled-block",0);
 391                 }
 392         }
 393
 394         block->set_type(type);
 395         return block;
 396 }
 397
 398 /* Might GC */
 399 code_block *factor_vm::add_code_block(code_block_type type, cell code_, cell labels_, cell owner_, cell relocation_, cell parameters_, cell literals_)
 400 {
 401         data_root<byte_array> code(code_,this);
 402         data_root<object> labels(labels_,this);
 403         data_root<object> owner(owner_,this);
 404         data_root<byte_array> relocation(relocation_,this);
 405         data_root<array> parameters(parameters_,this);
 406         data_root<array> literals(literals_,this);
 407
 408         cell code_length = array_capacity(code.untagged());
 409         code_block *compiled = allot_code_block(code_length,type);
 410
 411         compiled->owner = owner.value();
 412
 413         /* slight space optimization */
 414         if(relocation.type() == BYTE_ARRAY_TYPE && array_capacity(relocation.untagged()) == 0)
 415                 compiled->relocation = false_object;
 416         else
 417                 compiled->relocation = relocation.value();
 418
 419         if(parameters.type() == ARRAY_TYPE && array_capacity(parameters.untagged()) == 0)
 420                 compiled->parameters = false_object;
 421         else
 422                 compiled->parameters = parameters.value();
 423
 424         /* code */
 425         memcpy(compiled + 1,code.untagged() + 1,code_length);
 426
 427         /* fixup labels */
 428         if(to_boolean(labels.value()))
 429                 fixup_labels(labels.as<array>().untagged(),compiled);
 430
 431         /* Once we are ready, fill in literal and word references in this code
 432         block's instruction operands. In most cases this is done right after this
 433         method returns, except when compiling words with the non-optimizing
 434         compiler at the beginning of bootstrap */
 435         this->code->uninitialized_blocks.insert(std::make_pair(compiled,literals.value()));
 436
 437         /* next time we do a minor GC, we have to trace this code block, since
 438         the fields of the code_block struct might point into nursery or aging */
 439         this->code->write_barrier(compiled);
 440
 441         return compiled;
 442 }
 443
 444 /* Find the RT_DLSYM relocation nearest to the given return address. */
 445 struct find_symbol_at_address_visitor {
 446         factor_vm *parent;
 447         cell return_address;
 448         cell symbol;
 449         cell library;
 450
 451         find_symbol_at_address_visitor(factor_vm *parent_, cell return_address_) :
 452                 parent(parent_), return_address(return_address_),
 453                 symbol(false_object), library(false_object) { }
 454
 455         void operator()(instruction_operand op)
 456         {
 457                 if(op.rel_type() == RT_DLSYM && op.pointer <= return_address)
 458                 {
 459                         code_block *compiled = op.compiled;
 460                         array *parameters = untag<array>(compiled->parameters);
 461                         cell index = op.index;
 462                         symbol = array_nth(parameters,index);
 463                         library = array_nth(parameters,index + 1);
 464                 }
 465         }
 466 };
 467
 468 /* References to undefined symbols are patched up to call this function on
 469 image load. It finds the symbol and library, and throws an error. */
 470 void factor_vm::undefined_symbol()
 471 {
 472         stack_frame *frame = innermost_stack_frame(ctx->callstack_bottom,
 473                 ctx->callstack_top);
 474         code_block *compiled = frame_code(frame);
 475         cell return_address = (cell)FRAME_RETURN_ADDRESS(frame, this);
 476         find_symbol_at_address_visitor visitor(this, return_address);
 477         compiled->each_instruction_operand(visitor);
 478         if (!to_boolean(visitor.symbol))
 479                 critical_error("Can't find RT_DLSYM at return address", return_address);
 480         else
 481                 general_error(ERROR_UNDEFINED_SYMBOL,visitor.symbol,visitor.library);
 482 }
 483
 484 void undefined_symbol()
 485 {
 486         return current_vm()->undefined_symbol();
 487 }
 488
 489 }