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 /* References to undefined symbols are patched up to call this function on
 144 image load */
 145 void factor_vm::undefined_symbol()
 146 {
 147         general_error(ERROR_UNDEFINED_SYMBOL,false_object,false_object);
 148 }
 149
 150 void undefined_symbol()
 151 {
 152         return current_vm()->undefined_symbol();
 153 }
 154
 155 /* Look up an external library symbol referenced by a compiled code block */
 156 cell factor_vm::compute_dlsym_address(array *literals, cell index)
 157 {
 158         cell symbol = array_nth(literals,index);
 159         cell library = array_nth(literals,index + 1);
 160
 161         dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
 162
 163         void* undefined_symbol = (void*)factor::undefined_symbol;
 164         undefined_symbol = FUNCTION_CODE_POINTER(undefined_symbol);
 165         if(d != NULL && !d->handle)
 166                 return (cell)undefined_symbol;
 167
 168         switch(tagged<object>(symbol).type())
 169         {
 170         case BYTE_ARRAY_TYPE:
 171                 {
 172                         symbol_char *name = alien_offset(symbol);
 173                         void *sym = ffi_dlsym(d,name);
 174
 175                         if(sym)
 176                                 return (cell)sym;
 177                         else
 178                                 return (cell)undefined_symbol;
 179                 }
 180         case ARRAY_TYPE:
 181                 {
 182                         array *names = untag<array>(symbol);
 183                         for(cell i = 0; i < array_capacity(names); i++)
 184                         {
 185                                 symbol_char *name = alien_offset(array_nth(names,i));
 186                                 void *sym = ffi_dlsym(d,name);
 187
 188                                 if(sym)
 189                                         return (cell)sym;
 190                         }
 191                         return (cell)undefined_symbol;
 192                 }
 193         default:
 194                 critical_error("Bad symbol specifier",symbol);
 195                 return (cell)undefined_symbol;
 196         }
 197 }
 198
 199 #ifdef FACTOR_PPC
 200 cell factor_vm::compute_dlsym_toc_address(array *literals, cell index)
 201 {
 202         cell symbol = array_nth(literals,index);
 203         cell library = array_nth(literals,index + 1);
 204
 205         dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
 206
 207         void* undefined_toc = (void*)factor::undefined_symbol;
 208         undefined_toc = FUNCTION_TOC_POINTER(undefined_toc);
 209         if(d != NULL && !d->handle)
 210                 return (cell)undefined_toc;
 211
 212         switch(tagged<object>(symbol).type())
 213         {
 214         case BYTE_ARRAY_TYPE:
 215                 {
 216                         symbol_char *name = alien_offset(symbol);
 217                         void* toc = ffi_dlsym_toc(d,name);
 218                         if(toc)
 219                                 return (cell)toc;
 220                         else
 221                                 return (cell)undefined_toc;
 222                 }
 223         case ARRAY_TYPE:
 224                 {
 225                         array *names = untag<array>(symbol);
 226                         for(cell i = 0; i < array_capacity(names); i++)
 227                         {
 228                                 symbol_char *name = alien_offset(array_nth(names,i));
 229                                 void *toc = ffi_dlsym_toc(d,name);
 230
 231                                 if(toc)
 232                                         return (cell)toc;
 233                         }
 234                         return (cell)undefined_toc;
 235                 }
 236         default:
 237                 critical_error("Bad symbol specifier",symbol);
 238                 return (cell)undefined_toc;
 239         }
 240 }
 241 #endif
 242
 243
 244 cell factor_vm::compute_vm_address(cell arg)
 245 {
 246         return (cell)this + untag_fixnum(arg);
 247 }
 248
 249 void factor_vm::store_external_address(instruction_operand op)
 250 {
 251         code_block *compiled = op.parent_code_block();
 252         array *parameters = (to_boolean(compiled->parameters) ? untag<array>(compiled->parameters) : NULL);
 253         cell index = op.parameter_index();
 254
 255         switch(op.rel_type())
 256         {
 257         case RT_DLSYM:
 258                 op.store_value(compute_dlsym_address(parameters,index));
 259                 break;
 260         case RT_THIS:
 261                 op.store_value((cell)compiled->entry_point());
 262                 break;
 263         case RT_MEGAMORPHIC_CACHE_HITS:
 264                 op.store_value((cell)&dispatch_stats.megamorphic_cache_hits);
 265                 break;
 266         case RT_VM:
 267                 op.store_value(compute_vm_address(array_nth(parameters,index)));
 268                 break;
 269         case RT_CARDS_OFFSET:
 270                 op.store_value(cards_offset);
 271                 break;
 272         case RT_DECKS_OFFSET:
 273                 op.store_value(decks_offset);
 274                 break;
 275 #ifdef WINDOWS
 276         case RT_EXCEPTION_HANDLER:
 277                 op.store_value((cell)&factor::exception_handler);
 278                 break;
 279 #endif
 280 #ifdef FACTOR_PPC
 281         case RT_DLSYM_TOC:
 282                 op.store_value(compute_dlsym_toc_address(parameters,index));
 283                 break;
 284 #endif
 285         default:
 286                 critical_error("Bad rel type in store_external_address()",op.rel_type());
 287                 break;
 288         }
 289 }
 290
 291 cell factor_vm::compute_here_address(cell arg, cell offset, code_block *compiled)
 292 {
 293         fixnum n = untag_fixnum(arg);
 294         if(n >= 0)
 295                 return (cell)compiled->entry_point() + offset + n;
 296         else
 297                 return (cell)compiled->entry_point() - n;
 298 }
 299
 300 struct initial_code_block_visitor {
 301         factor_vm *parent;
 302         cell literals;
 303         cell literal_index;
 304
 305         explicit initial_code_block_visitor(factor_vm *parent_, cell literals_)
 306                 : parent(parent_), literals(literals_), literal_index(0) {}
 307
 308         cell next_literal()
 309         {
 310                 return array_nth(untag<array>(literals),literal_index++);
 311         }
 312
 313         void operator()(instruction_operand op)
 314         {
 315                 switch(op.rel_type())
 316                 {
 317                 case RT_LITERAL:
 318                         op.store_value(next_literal());
 319                         break;
 320                 case RT_ENTRY_POINT:
 321                         op.store_value(parent->compute_entry_point_address(next_literal()));
 322                         break;
 323                 case RT_ENTRY_POINT_PIC:
 324                         op.store_value(parent->compute_entry_point_pic_address(next_literal()));
 325                         break;
 326                 case RT_ENTRY_POINT_PIC_TAIL:
 327                         op.store_value(parent->compute_entry_point_pic_tail_address(next_literal()));
 328                         break;
 329                 case RT_HERE:
 330                         op.store_value(parent->compute_here_address(next_literal(),op.rel_offset(),op.parent_code_block()));
 331                         break;
 332                 case RT_UNTAGGED:
 333                         op.store_value(untag_fixnum(next_literal()));
 334                         break;
 335                 default:
 336                         parent->store_external_address(op);
 337                         break;
 338                 }
 339         }
 340 };
 341
 342 /* Perform all fixups on a code block */
 343 void factor_vm::initialize_code_block(code_block *compiled, cell literals)
 344 {
 345         initial_code_block_visitor visitor(this,literals);
 346         compiled->each_instruction_operand(visitor);
 347         compiled->flush_icache();
 348
 349         /* next time we do a minor GC, we have to trace this code block, since
 350         the newly-installed instruction operands might point to literals in
 351         nursery or aging */
 352         code->write_barrier(compiled);
 353 }
 354
 355 void factor_vm::initialize_code_block(code_block *compiled)
 356 {
 357         std::map<code_block *,cell>::iterator iter = code->uninitialized_blocks.find(compiled);
 358         initialize_code_block(compiled,iter->second);
 359         code->uninitialized_blocks.erase(iter);
 360 }
 361
 362 /* Fixup labels. This is done at compile time, not image load time */
 363 void factor_vm::fixup_labels(array *labels, code_block *compiled)
 364 {
 365         cell size = array_capacity(labels);
 366
 367         for(cell i = 0; i < size; i += 3)
 368         {
 369                 relocation_class rel_class = (relocation_class)untag_fixnum(array_nth(labels,i));
 370                 cell offset = untag_fixnum(array_nth(labels,i + 1));
 371                 cell target = untag_fixnum(array_nth(labels,i + 2));
 372
 373                 relocation_entry new_entry(RT_HERE,rel_class,offset);
 374
 375                 instruction_operand op(new_entry,compiled,0);
 376                 op.store_value(target + (cell)compiled->entry_point());
 377         }
 378 }
 379
 380 /* Might GC */
 381 code_block *factor_vm::allot_code_block(cell size, code_block_type type)
 382 {
 383         code_block *block = code->allocator->allot(size + sizeof(code_block));
 384
 385         /* If allocation failed, do a full GC and compact the code heap.
 386         A full GC that occurs as a result of the data heap filling up does not
 387         trigger a compaction. This setup ensures that most GCs do not compact
 388         the code heap, but if the code fills up, it probably means it will be
 389         fragmented after GC anyway, so its best to compact. */
 390         if(block == NULL)
 391         {
 392                 primitive_compact_gc();
 393                 block = code->allocator->allot(size + sizeof(code_block));
 394
 395                 /* Insufficient room even after code GC, give up */
 396                 if(block == NULL)
 397                 {
 398                         std::cout << "Code heap used: " << code->allocator->occupied_space() << "\n";
 399                         std::cout << "Code heap free: " << code->allocator->free_space() << "\n";
 400                         fatal_error("Out of memory in add-compiled-block",0);
 401                 }
 402         }
 403
 404         block->set_type(type);
 405         return block;
 406 }
 407
 408 /* Might GC */
 409 code_block *factor_vm::add_code_block(code_block_type type, cell code_, cell labels_, cell owner_, cell relocation_, cell parameters_, cell literals_)
 410 {
 411         data_root<byte_array> code(code_,this);
 412         data_root<object> labels(labels_,this);
 413         data_root<object> owner(owner_,this);
 414         data_root<byte_array> relocation(relocation_,this);
 415         data_root<array> parameters(parameters_,this);
 416         data_root<array> literals(literals_,this);
 417
 418         cell code_length = array_capacity(code.untagged());
 419         code_block *compiled = allot_code_block(code_length,type);
 420
 421         compiled->owner = owner.value();
 422
 423         /* slight space optimization */
 424         if(relocation.type() == BYTE_ARRAY_TYPE && array_capacity(relocation.untagged()) == 0)
 425                 compiled->relocation = false_object;
 426         else
 427                 compiled->relocation = relocation.value();
 428
 429         if(parameters.type() == ARRAY_TYPE && array_capacity(parameters.untagged()) == 0)
 430                 compiled->parameters = false_object;
 431         else
 432                 compiled->parameters = parameters.value();
 433
 434         /* code */
 435         memcpy(compiled + 1,code.untagged() + 1,code_length);
 436
 437         /* fixup labels */
 438         if(to_boolean(labels.value()))
 439                 fixup_labels(labels.as<array>().untagged(),compiled);
 440
 441         /* Once we are ready, fill in literal and word references in this code
 442         block's instruction operands. In most cases this is done right after this
 443         method returns, except when compiling words with the non-optimizing
 444         compiler at the beginning of bootstrap */
 445         this->code->uninitialized_blocks.insert(std::make_pair(compiled,literals.value()));
 446
 447         /* next time we do a minor GC, we have to trace this code block, since
 448         the fields of the code_block struct might point into nursery or aging */
 449         this->code->write_barrier(compiled);
 450
 451         return compiled;
 452 }
 453
 454 }