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