vm/code_blocks.cpp

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