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((cell)&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_FLOAT:
 269                         op.store_float(next_literal());
 270                         break;
 271                 case RT_ENTRY_POINT:
 272                         op.store_value(parent->compute_entry_point_address(next_literal()));
 273                         break;
 274                 case RT_ENTRY_POINT_PIC:
 275                         op.store_value(parent->compute_entry_point_pic_address(next_literal()));
 276                         break;
 277                 case RT_ENTRY_POINT_PIC_TAIL:
 278                         op.store_value(parent->compute_entry_point_pic_tail_address(next_literal()));
 279                         break;
 280                 case RT_HERE:
 281                         op.store_value(parent->compute_here_address(next_literal(),op.rel_offset(),op.parent_code_block()));
 282                         break;
 283                 case RT_UNTAGGED:
 284                         op.store_value(untag_fixnum(next_literal()));
 285                         break;
 286                 default:
 287                         parent->store_external_address(op);
 288                         break;
 289                 }
 290         }
 291 };
 292
 293 /* Perform all fixups on a code block */
 294 void factor_vm::initialize_code_block(code_block *compiled, cell literals)
 295 {
 296         initial_code_block_visitor visitor(this,literals);
 297         compiled->each_instruction_operand(visitor);
 298         compiled->flush_icache();
 299
 300         /* next time we do a minor GC, we have to trace this code block, since
 301         the newly-installed instruction operands might point to literals in
 302         nursery or aging */
 303         code->write_barrier(compiled);
 304 }
 305
 306 void factor_vm::initialize_code_block(code_block *compiled)
 307 {
 308         std::map<code_block *,cell>::iterator iter = code->uninitialized_blocks.find(compiled);
 309         initialize_code_block(compiled,iter->second);
 310         code->uninitialized_blocks.erase(iter);
 311 }
 312
 313 /* Fixup labels. This is done at compile time, not image load time */
 314 void factor_vm::fixup_labels(array *labels, code_block *compiled)
 315 {
 316         cell size = array_capacity(labels);
 317
 318         for(cell i = 0; i < size; i += 3)
 319         {
 320                 relocation_class rel_class = (relocation_class)untag_fixnum(array_nth(labels,i));
 321                 cell offset = untag_fixnum(array_nth(labels,i + 1));
 322                 cell target = untag_fixnum(array_nth(labels,i + 2));
 323
 324                 relocation_entry new_entry(RT_HERE,rel_class,offset);
 325
 326                 instruction_operand op(new_entry,compiled,0);
 327                 op.store_value(target + (cell)compiled->entry_point());
 328         }
 329 }
 330
 331 /* Might GC */
 332 code_block *factor_vm::allot_code_block(cell size, code_block_type type)
 333 {
 334         code_block *block = code->allocator->allot(size + sizeof(code_block));
 335
 336         /* If allocation failed, do a full GC and compact the code heap.
 337         A full GC that occurs as a result of the data heap filling up does not
 338         trigger a compaction. This setup ensures that most GCs do not compact
 339         the code heap, but if the code fills up, it probably means it will be
 340         fragmented after GC anyway, so its best to compact. */
 341         if(block == NULL)
 342         {
 343                 primitive_compact_gc();
 344                 block = code->allocator->allot(size + sizeof(code_block));
 345
 346                 /* Insufficient room even after code GC, give up */
 347                 if(block == NULL)
 348                 {
 349                         std::cout << "Code heap used: " << code->allocator->occupied_space() << "\n";
 350                         std::cout << "Code heap free: " << code->allocator->free_space() << "\n";
 351                         fatal_error("Out of memory in add-compiled-block",0);
 352                 }
 353         }
 354
 355         block->set_type(type);
 356         return block;
 357 }
 358
 359 /* Might GC */
 360 code_block *factor_vm::add_code_block(code_block_type type, cell code_, cell labels_, cell owner_, cell relocation_, cell parameters_, cell literals_)
 361 {
 362         data_root<byte_array> code(code_,this);
 363         data_root<object> labels(labels_,this);
 364         data_root<object> owner(owner_,this);
 365         data_root<byte_array> relocation(relocation_,this);
 366         data_root<array> parameters(parameters_,this);
 367         data_root<array> literals(literals_,this);
 368
 369         cell code_length = array_capacity(code.untagged());
 370         code_block *compiled = allot_code_block(code_length,type);
 371
 372         compiled->owner = owner.value();
 373
 374         /* slight space optimization */
 375         if(relocation.type() == BYTE_ARRAY_TYPE && array_capacity(relocation.untagged()) == 0)
 376                 compiled->relocation = false_object;
 377         else
 378                 compiled->relocation = relocation.value();
 379
 380         if(parameters.type() == ARRAY_TYPE && array_capacity(parameters.untagged()) == 0)
 381                 compiled->parameters = false_object;
 382         else
 383                 compiled->parameters = parameters.value();
 384
 385         /* code */
 386         memcpy(compiled + 1,code.untagged() + 1,code_length);
 387
 388         /* fixup labels */
 389         if(to_boolean(labels.value()))
 390                 fixup_labels(labels.as<array>().untagged(),compiled);
 391
 392         /* Once we are ready, fill in literal and word references in this code
 393         block's instruction operands. In most cases this is done right after this
 394         method returns, except when compiling words with the non-optimizing
 395         compiler at the beginning of bootstrap */
 396         this->code->uninitialized_blocks.insert(std::make_pair(compiled,literals.value()));
 397
 398         /* next time we do a minor GC, we have to trace this code block, since
 399         the fields of the code_block struct might point into nursery or aging */
 400         this->code->write_barrier(compiled);
 401
 402         return compiled;
 403 }
 404
 405 }