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
  71         explicit update_word_references_relocation_visitor(factor_vm *parent_) : parent(parent_) {}
  72
  73         void operator()(instruction_operand op)
  74         {
  75                 switch(op.rel_type())
  76                 {
  77                 case RT_ENTRY_POINT:
  78                         {
  79                                 code_block *compiled = op.load_code_block();
  80                                 cell owner = compiled->owner;
  81                                 if(to_boolean(owner))
  82                                         op.store_value(parent->compute_entry_point_address(owner));
  83                                 break;
  84                         }
  85                 case RT_ENTRY_POINT_PIC:
  86                         {
  87                                 code_block *compiled = op.load_code_block();
  88                                 cell owner = parent->code_block_owner(compiled);
  89                                 if(to_boolean(owner))
  90                                         op.store_value(parent->compute_entry_point_pic_address(owner));
  91                                 break;
  92                         }
  93                 case RT_ENTRY_POINT_PIC_TAIL:
  94                         {
  95                                 code_block *compiled = op.load_code_block();
  96                                 cell owner = parent->code_block_owner(compiled);
  97                                 if(to_boolean(owner))
  98                                         op.store_value(parent->compute_entry_point_pic_tail_address(owner));
  99                                 break;
 100                         }
 101                 default:
 102                         break;
 103                 }
 104         }
 105 };
 106
 107 /* Relocate new code blocks completely; updating references to literals,
 108 dlsyms, and words. For all other words in the code heap, we only need
 109 to update references to other words, without worrying about literals
 110 or dlsyms. */
 111 void factor_vm::update_word_references(code_block *compiled)
 112 {
 113         if(code->uninitialized_p(compiled))
 114                 initialize_code_block(compiled);
 115         /* update_word_references() is always applied to every block in
 116            the code heap. Since it resets all call sites to point to
 117            their canonical entry point (cold entry point for non-tail calls,
 118            standard entry point for tail calls), it means that no PICs
 119            are referenced after this is done. So instead of polluting
 120            the code heap with dead PICs that will be freed on the next
 121            GC, we add them to the free list immediately. */
 122         else if(compiled->pic_p())
 123                 code->free(compiled);
 124         else
 125         {
 126                 update_word_references_relocation_visitor visitor(this);
 127                 compiled->each_instruction_operand(visitor);
 128                 compiled->flush_icache();
 129         }
 130 }
 131
 132 void factor_vm::check_code_address(cell address)
 133 {
 134 #ifdef FACTOR_DEBUG
 135         assert(address >= code->seg->start && address < code->seg->end);
 136 #endif
 137 }
 138
 139 /* References to undefined symbols are patched up to call this function on
 140 image load */
 141 void factor_vm::undefined_symbol()
 142 {
 143         general_error(ERROR_UNDEFINED_SYMBOL,false_object,false_object,NULL);
 144 }
 145
 146 void undefined_symbol()
 147 {
 148         return tls_vm()->undefined_symbol();
 149 }
 150
 151 /* Look up an external library symbol referenced by a compiled code block */
 152 cell factor_vm::compute_dlsym_address(array *literals, cell index)
 153 {
 154         cell symbol = array_nth(literals,index);
 155         cell library = array_nth(literals,index + 1);
 156
 157         dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
 158
 159         if(d != NULL && !d->handle)
 160                 return (cell)factor::undefined_symbol;
 161
 162         switch(tagged<object>(symbol).type())
 163         {
 164         case BYTE_ARRAY_TYPE:
 165                 {
 166                         symbol_char *name = alien_offset(symbol);
 167                         void *sym = ffi_dlsym(d,name);
 168
 169                         if(sym)
 170                                 return (cell)sym;
 171                         else
 172                                 return (cell)factor::undefined_symbol;
 173                 }
 174         case ARRAY_TYPE:
 175                 {
 176                         array *names = untag<array>(symbol);
 177                         for(cell i = 0; i < array_capacity(names); i++)
 178                         {
 179                                 symbol_char *name = alien_offset(array_nth(names,i));
 180                                 void *sym = ffi_dlsym(d,name);
 181
 182                                 if(sym)
 183                                         return (cell)sym;
 184                         }
 185                         return (cell)factor::undefined_symbol;
 186                 }
 187         default:
 188                 critical_error("Bad symbol specifier",symbol);
 189                 return (cell)factor::undefined_symbol;
 190         }
 191 }
 192
 193 cell factor_vm::compute_vm_address(cell arg)
 194 {
 195         return (cell)this + untag_fixnum(arg);
 196 }
 197
 198 void factor_vm::store_external_address(instruction_operand op)
 199 {
 200         code_block *compiled = op.parent_code_block();
 201         array *parameters = (to_boolean(compiled->parameters) ? untag<array>(compiled->parameters) : NULL);
 202         cell index = op.parameter_index();
 203
 204         switch(op.rel_type())
 205         {
 206         case RT_DLSYM:
 207                 op.store_value(compute_dlsym_address(parameters,index));
 208                 break;
 209         case RT_THIS:
 210                 op.store_value((cell)compiled->entry_point());
 211                 break;
 212         case RT_MEGAMORPHIC_CACHE_HITS:
 213                 op.store_value((cell)&dispatch_stats.megamorphic_cache_hits);
 214                 break;
 215         case RT_VM:
 216                 op.store_value(compute_vm_address(array_nth(parameters,index)));
 217                 break;
 218         case RT_CARDS_OFFSET:
 219                 op.store_value(cards_offset);
 220                 break;
 221         case RT_DECKS_OFFSET:
 222                 op.store_value(decks_offset);
 223                 break;
 224         default:
 225                 critical_error("Bad rel type",op.rel_type());
 226                 break;
 227         }
 228 }
 229
 230 cell factor_vm::compute_here_address(cell arg, cell offset, code_block *compiled)
 231 {
 232         fixnum n = untag_fixnum(arg);
 233         if(n >= 0)
 234                 return (cell)compiled->entry_point() + offset + n;
 235         else
 236                 return (cell)compiled->entry_point() - n;
 237 }
 238
 239 struct initial_code_block_visitor {
 240         factor_vm *parent;
 241         cell literals;
 242         cell literal_index;
 243
 244         explicit initial_code_block_visitor(factor_vm *parent_, cell literals_)
 245                 : parent(parent_), literals(literals_), literal_index(0) {}
 246
 247         cell next_literal()
 248         {
 249                 return array_nth(untag<array>(literals),literal_index++);
 250         }
 251
 252         void operator()(instruction_operand op)
 253         {
 254                 switch(op.rel_type())
 255                 {
 256                 case RT_LITERAL:
 257                         op.store_value(next_literal());
 258                         break;
 259                 case RT_ENTRY_POINT:
 260                         op.store_value(parent->compute_entry_point_address(next_literal()));
 261                         break;
 262                 case RT_ENTRY_POINT_PIC:
 263                         op.store_value(parent->compute_entry_point_pic_address(next_literal()));
 264                         break;
 265                 case RT_ENTRY_POINT_PIC_TAIL:
 266                         op.store_value(parent->compute_entry_point_pic_tail_address(next_literal()));
 267                         break;
 268                 case RT_HERE:
 269                         op.store_value(parent->compute_here_address(next_literal(),op.rel_offset(),op.parent_code_block()));
 270                         break;
 271                 case RT_UNTAGGED:
 272                         op.store_value(untag_fixnum(next_literal()));
 273                         break;
 274                 default:
 275                         parent->store_external_address(op);
 276                         break;
 277                 }
 278         }
 279 };
 280
 281 /* Perform all fixups on a code block */
 282 void factor_vm::initialize_code_block(code_block *compiled)
 283 {
 284         std::map<code_block *,cell>::iterator iter = code->uninitialized_blocks.find(compiled);
 285
 286         initial_code_block_visitor visitor(this,iter->second);
 287         compiled->each_instruction_operand(visitor);
 288         compiled->flush_icache();
 289
 290         code->uninitialized_blocks.erase(iter);
 291
 292         /* next time we do a minor GC, we have to trace this code block, since
 293         the newly-installed instruction operands might point to literals in
 294         nursery or aging */
 295         code->write_barrier(compiled);
 296 }
 297
 298 /* Fixup labels. This is done at compile time, not image load time */
 299 void factor_vm::fixup_labels(array *labels, code_block *compiled)
 300 {
 301         cell size = array_capacity(labels);
 302
 303         for(cell i = 0; i < size; i += 3)
 304         {
 305                 relocation_class rel_class = (relocation_class)untag_fixnum(array_nth(labels,i));
 306                 cell offset = untag_fixnum(array_nth(labels,i + 1));
 307                 cell target = untag_fixnum(array_nth(labels,i + 2));
 308
 309                 relocation_entry new_entry(RT_HERE,rel_class,offset);
 310
 311                 instruction_operand op(new_entry,compiled,0);
 312                 op.store_value(target + (cell)compiled->entry_point());
 313         }
 314 }
 315
 316 /* Might GC */
 317 code_block *factor_vm::allot_code_block(cell size, code_block_type type)
 318 {
 319         code_block *block = code->allocator->allot(size + sizeof(code_block));
 320
 321         /* If allocation failed, do a full GC and compact the code heap.
 322         A full GC that occurs as a result of the data heap filling up does not
 323         trigger a compaction. This setup ensures that most GCs do not compact
 324         the code heap, but if the code fills up, it probably means it will be
 325         fragmented after GC anyway, so its best to compact. */
 326         if(block == NULL)
 327         {
 328                 primitive_compact_gc();
 329                 block = code->allocator->allot(size + sizeof(code_block));
 330
 331                 /* Insufficient room even after code GC, give up */
 332                 if(block == NULL)
 333                 {
 334                         std::cout << "Code heap used: " << code->allocator->occupied_space() << "\n";
 335                         std::cout << "Code heap free: " << code->allocator->free_space() << "\n";
 336                         fatal_error("Out of memory in add-compiled-block",0);
 337                 }
 338         }
 339
 340         block->set_type(type);
 341         return block;
 342 }
 343
 344 /* Might GC */
 345 code_block *factor_vm::add_code_block(code_block_type type, cell code_, cell labels_, cell owner_, cell relocation_, cell parameters_, cell literals_)
 346 {
 347         data_root<byte_array> code(code_,this);
 348         data_root<object> labels(labels_,this);
 349         data_root<object> owner(owner_,this);
 350         data_root<byte_array> relocation(relocation_,this);
 351         data_root<array> parameters(parameters_,this);
 352         data_root<array> literals(literals_,this);
 353
 354         cell code_length = array_capacity(code.untagged());
 355         code_block *compiled = allot_code_block(code_length,type);
 356
 357         compiled->owner = owner.value();
 358
 359         /* slight space optimization */
 360         if(relocation.type() == BYTE_ARRAY_TYPE && array_capacity(relocation.untagged()) == 0)
 361                 compiled->relocation = false_object;
 362         else
 363                 compiled->relocation = relocation.value();
 364
 365         if(parameters.type() == ARRAY_TYPE && array_capacity(parameters.untagged()) == 0)
 366                 compiled->parameters = false_object;
 367         else
 368                 compiled->parameters = parameters.value();
 369
 370         /* code */
 371         memcpy(compiled + 1,code.untagged() + 1,code_length);
 372
 373         /* fixup labels */
 374         if(to_boolean(labels.value()))
 375                 fixup_labels(labels.as<array>().untagged(),compiled);
 376
 377         /* Once we are ready, fill in literal and word references in this code
 378         block's instruction operands. In most cases this is done right after this
 379         method returns, except when compiling words with the non-optimizing
 380         compiler at the beginning of bootstrap */
 381         this->code->uninitialized_blocks.insert(std::make_pair(compiled,literals.value()));
 382
 383         /* next time we do a minor GC, we have to trace this code block, since
 384         the fields of the code_block struct might point into nursery or aging */
 385         this->code->write_barrier(compiled);
 386
 387         return compiled;
 388 }
 389
 390 }