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