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