vm/code_block.cpp

   1 #include "master.hpp"
   2
   3 namespace factor
   4 {
   5
   6 relocation_type factor_vm::relocation_type_of(relocation_entry r)
   7 {
   8         return (relocation_type)((r & 0xf0000000) >> 28);
   9 }
  10
  11 relocation_class factor_vm::relocation_class_of(relocation_entry r)
  12 {
  13         return (relocation_class)((r & 0x0f000000) >> 24);
  14 }
  15
  16 cell factor_vm::relocation_offset_of(relocation_entry r)
  17 {
  18         return (r & 0x00ffffff);
  19 }
  20
  21 void factor_vm::flush_icache_for(code_block *block)
  22 {
  23         flush_icache((cell)block,block->size());
  24 }
  25
  26 int factor_vm::number_of_parameters(relocation_type type)
  27 {
  28         switch(type)
  29         {
  30         case RT_PRIMITIVE:
  31         case RT_XT:
  32         case RT_XT_PIC:
  33         case RT_XT_PIC_TAIL:
  34         case RT_IMMEDIATE:
  35         case RT_HERE:
  36         case RT_UNTAGGED:
  37         case RT_VM:
  38                 return 1;
  39         case RT_DLSYM:
  40                 return 2;
  41         case RT_THIS:
  42         case RT_CONTEXT:
  43         case RT_MEGAMORPHIC_CACHE_HITS:
  44         case RT_CARDS_OFFSET:
  45         case RT_DECKS_OFFSET:
  46                 return 0;
  47         default:
  48                 critical_error("Bad rel type",type);
  49                 return -1; /* Can't happen */
  50         }
  51 }
  52
  53 void *factor_vm::object_xt(cell obj)
  54 {
  55         switch(tagged<object>(obj).type())
  56         {
  57         case WORD_TYPE:
  58                 return untag<word>(obj)->xt;
  59         case QUOTATION_TYPE:
  60                 return untag<quotation>(obj)->xt;
  61         default:
  62                 critical_error("Expected word or quotation",obj);
  63                 return NULL;
  64         }
  65 }
  66
  67 void *factor_vm::xt_pic(word *w, cell tagged_quot)
  68 {
  69         if(!to_boolean(tagged_quot) || max_pic_size == 0)
  70                 return w->xt;
  71         else
  72         {
  73                 quotation *quot = untag<quotation>(tagged_quot);
  74                 if(quot->code)
  75                         return quot->xt;
  76                 else
  77                         return w->xt;
  78         }
  79 }
  80
  81 void *factor_vm::word_xt_pic(word *w)
  82 {
  83         return xt_pic(w,w->pic_def);
  84 }
  85
  86 void *factor_vm::word_xt_pic_tail(word *w)
  87 {
  88         return xt_pic(w,w->pic_tail_def);
  89 }
  90
  91 /* References to undefined symbols are patched up to call this function on
  92 image load */
  93 void factor_vm::undefined_symbol()
  94 {
  95         general_error(ERROR_UNDEFINED_SYMBOL,false_object,false_object,NULL);
  96 }
  97
  98 void undefined_symbol()
  99 {
 100         return tls_vm()->undefined_symbol();
 101 }
 102
 103 /* Look up an external library symbol referenced by a compiled code block */
 104 void *factor_vm::get_rel_symbol(array *literals, cell index)
 105 {
 106         cell symbol = array_nth(literals,index);
 107         cell library = array_nth(literals,index + 1);
 108
 109         dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
 110
 111         if(d != NULL && !d->dll)
 112                 return (void *)factor::undefined_symbol;
 113
 114         switch(tagged<object>(symbol).type())
 115         {
 116         case BYTE_ARRAY_TYPE:
 117                 {
 118                         symbol_char *name = alien_offset(symbol);
 119                         void *sym = ffi_dlsym(d,name);
 120
 121                         if(sym)
 122                                 return sym;
 123                         else
 124                         {
 125                                 return (void *)factor::undefined_symbol;
 126                         }
 127                 }
 128         case ARRAY_TYPE:
 129                 {
 130                         cell i;
 131                         array *names = untag<array>(symbol);
 132                         for(i = 0; i < array_capacity(names); i++)
 133                         {
 134                                 symbol_char *name = alien_offset(array_nth(names,i));
 135                                 void *sym = ffi_dlsym(d,name);
 136
 137                                 if(sym)
 138                                         return sym;
 139                         }
 140                         return (void *)factor::undefined_symbol;
 141                 }
 142         default:
 143                 critical_error("Bad symbol specifier",symbol);
 144                 return (void *)factor::undefined_symbol;
 145         }
 146 }
 147
 148 cell factor_vm::compute_relocation(relocation_entry rel, cell index, code_block *compiled)
 149 {
 150         array *literals = (to_boolean(compiled->literals)
 151                 ? untag<array>(compiled->literals) : NULL);
 152         cell offset = relocation_offset_of(rel) + (cell)compiled->xt();
 153
 154 #define ARG array_nth(literals,index)
 155
 156         switch(relocation_type_of(rel))
 157         {
 158         case RT_PRIMITIVE:
 159                 return (cell)primitives[untag_fixnum(ARG)];
 160         case RT_DLSYM:
 161                 return (cell)get_rel_symbol(literals,index);
 162         case RT_IMMEDIATE:
 163                 return ARG;
 164         case RT_XT:
 165                 return (cell)object_xt(ARG);
 166         case RT_XT_PIC:
 167                 return (cell)word_xt_pic(untag<word>(ARG));
 168         case RT_XT_PIC_TAIL:
 169                 return (cell)word_xt_pic_tail(untag<word>(ARG));
 170         case RT_HERE:
 171         {
 172                 fixnum arg = untag_fixnum(ARG);
 173                 return (arg >= 0 ? offset + arg : (cell)(compiled + 1) - arg);
 174         }
 175         case RT_THIS:
 176                 return (cell)(compiled + 1);
 177         case RT_CONTEXT:
 178                 return (cell)&ctx;
 179         case RT_UNTAGGED:
 180                 return untag_fixnum(ARG);
 181         case RT_MEGAMORPHIC_CACHE_HITS:
 182                 return (cell)&megamorphic_cache_hits;
 183         case RT_VM:
 184                 return (cell)this + untag_fixnum(ARG);
 185         case RT_CARDS_OFFSET:
 186                 return cards_offset;
 187         case RT_DECKS_OFFSET:
 188                 return decks_offset;
 189         default:
 190                 critical_error("Bad rel type",rel);
 191                 return 0; /* Can't happen */
 192         }
 193
 194 #undef ARG
 195 }
 196
 197 template<typename Iterator> void factor_vm::iterate_relocations(code_block *compiled, Iterator &iter)
 198 {
 199         if(to_boolean(compiled->relocation))
 200         {
 201                 byte_array *relocation = untag<byte_array>(compiled->relocation);
 202
 203                 cell index = 0;
 204                 cell length = array_capacity(relocation) / sizeof(relocation_entry);
 205
 206                 for(cell i = 0; i < length; i++)
 207                 {
 208                         relocation_entry rel = relocation->data<relocation_entry>()[i];
 209                         iter(rel,index,compiled);
 210                         index += number_of_parameters(relocation_type_of(rel));
 211                 }
 212         }
 213 }
 214
 215 /* Store a 32-bit value into a PowerPC LIS/ORI sequence */
 216 void factor_vm::store_address_2_2(cell *ptr, cell value)
 217 {
 218         ptr[-1] = ((ptr[-1] & ~0xffff) | ((value >> 16) & 0xffff));
 219         ptr[ 0] = ((ptr[ 0] & ~0xffff) | (value & 0xffff));
 220 }
 221
 222 /* Store a value into a bitfield of a PowerPC instruction */
 223 void factor_vm::store_address_masked(cell *ptr, fixnum value, cell mask, fixnum shift)
 224 {
 225         /* This is unaccurate but good enough */
 226         fixnum test = (fixnum)mask >> 1;
 227         if(value <= -test || value >= test)
 228                 critical_error("Value does not fit inside relocation",0);
 229
 230         *ptr = ((*ptr & ~mask) | ((value >> shift) & mask));
 231 }
 232
 233 /* Perform a fixup on a code block */
 234 void factor_vm::store_address_in_code_block(cell klass, cell offset, fixnum absolute_value)
 235 {
 236         fixnum relative_value = absolute_value - offset;
 237
 238         switch(klass)
 239         {
 240         case RC_ABSOLUTE_CELL:
 241                 *(cell *)offset = absolute_value;
 242                 break;
 243         case RC_ABSOLUTE:
 244                 *(u32*)offset = absolute_value;
 245                 break;
 246         case RC_RELATIVE:
 247                 *(u32*)offset = relative_value - sizeof(u32);
 248                 break;
 249         case RC_ABSOLUTE_PPC_2_2:
 250                 store_address_2_2((cell *)offset,absolute_value);
 251                 break;
 252         case RC_ABSOLUTE_PPC_2:
 253                 store_address_masked((cell *)offset,absolute_value,rel_absolute_ppc_2_mask,0);
 254                 break;
 255         case RC_RELATIVE_PPC_2:
 256                 store_address_masked((cell *)offset,relative_value,rel_relative_ppc_2_mask,0);
 257                 break;
 258         case RC_RELATIVE_PPC_3:
 259                 store_address_masked((cell *)offset,relative_value,rel_relative_ppc_3_mask,0);
 260                 break;
 261         case RC_RELATIVE_ARM_3:
 262                 store_address_masked((cell *)offset,relative_value - sizeof(cell) * 2,
 263                         rel_relative_arm_3_mask,2);
 264                 break;
 265         case RC_INDIRECT_ARM:
 266                 store_address_masked((cell *)offset,relative_value - sizeof(cell),
 267                         rel_indirect_arm_mask,0);
 268                 break;
 269         case RC_INDIRECT_ARM_PC:
 270                 store_address_masked((cell *)offset,relative_value - sizeof(cell) * 2,
 271                         rel_indirect_arm_mask,0);
 272                 break;
 273         default:
 274                 critical_error("Bad rel class",klass);
 275                 break;
 276         }
 277 }
 278
 279 struct literal_references_updater {
 280         factor_vm *parent;
 281
 282         explicit literal_references_updater(factor_vm *parent_) : parent(parent_) {}
 283
 284         void operator()(relocation_entry rel, cell index, code_block *compiled)
 285         {
 286                 if(parent->relocation_type_of(rel) == RT_IMMEDIATE)
 287                 {
 288                         cell offset = parent->relocation_offset_of(rel) + (cell)(compiled + 1);
 289                         array *literals = parent->untag<array>(compiled->literals);
 290                         fixnum absolute_value = array_nth(literals,index);
 291                         parent->store_address_in_code_block(parent->relocation_class_of(rel),offset,absolute_value);
 292                 }
 293         }
 294 };
 295
 296 /* Update pointers to literals from compiled code. */
 297 void factor_vm::update_literal_references(code_block *compiled)
 298 {
 299         if(!code->needs_fixup_p(compiled))
 300         {
 301                 literal_references_updater updater(this);
 302                 iterate_relocations(compiled,updater);
 303                 flush_icache_for(compiled);
 304         }
 305 }
 306
 307 /* Compute an address to store at a relocation */
 308 void factor_vm::relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled)
 309 {
 310 #ifdef FACTOR_DEBUG
 311         if(to_boolean(compiled->literals))
 312                 tagged<array>(compiled->literals).untag_check(this);
 313         if(to_boolean(compiled->relocation))
 314                 tagged<byte_array>(compiled->relocation).untag_check(this);
 315 #endif
 316
 317         store_address_in_code_block(relocation_class_of(rel),
 318                 relocation_offset_of(rel) + (cell)compiled->xt(),
 319                 compute_relocation(rel,index,compiled));
 320 }
 321
 322 struct word_references_updater {
 323         factor_vm *parent;
 324
 325         explicit word_references_updater(factor_vm *parent_) : parent(parent_) {}
 326         void operator()(relocation_entry rel, cell index, code_block *compiled)
 327         {
 328                 relocation_type type = parent->relocation_type_of(rel);
 329                 if(type == RT_XT || type == RT_XT_PIC || type == RT_XT_PIC_TAIL)
 330                         parent->relocate_code_block_step(rel,index,compiled);
 331         }
 332 };
 333
 334 /* Relocate new code blocks completely; updating references to literals,
 335 dlsyms, and words. For all other words in the code heap, we only need
 336 to update references to other words, without worrying about literals
 337 or dlsyms. */
 338 void factor_vm::update_word_references(code_block *compiled)
 339 {
 340         if(code->needs_fixup_p(compiled))
 341                 relocate_code_block(compiled);
 342         /* update_word_references() is always applied to every block in
 343            the code heap. Since it resets all call sites to point to
 344            their canonical XT (cold entry point for non-tail calls,
 345            standard entry point for tail calls), it means that no PICs
 346            are referenced after this is done. So instead of polluting
 347            the code heap with dead PICs that will be freed on the next
 348            GC, we add them to the free list immediately. */
 349         else if(compiled->type() == PIC_TYPE)
 350                 code->code_heap_free(compiled);
 351         else
 352         {
 353                 word_references_updater updater(this);
 354                 iterate_relocations(compiled,updater);
 355                 flush_icache_for(compiled);
 356         }
 357 }
 358
 359 /* This runs after a full collection */
 360 struct literal_and_word_references_updater {
 361         factor_vm *parent;
 362
 363         explicit literal_and_word_references_updater(factor_vm *parent_) : parent(parent_) {}
 364
 365         void operator()(relocation_entry rel, cell index, code_block *compiled)
 366         {
 367                 relocation_type type = parent->relocation_type_of(rel);
 368                 switch(type)
 369                 {
 370                 case RT_IMMEDIATE:
 371                 case RT_XT:
 372                 case RT_XT_PIC:
 373                 case RT_XT_PIC_TAIL:
 374                         parent->relocate_code_block_step(rel,index,compiled);
 375                         break;
 376                 default:
 377                         break;
 378                 }
 379         }
 380 };
 381
 382 void factor_vm::update_code_block_for_full_gc(code_block *compiled)
 383 {
 384         if(code->needs_fixup_p(compiled))
 385                 relocate_code_block(compiled);
 386         else
 387         {
 388                 literal_and_word_references_updater updater(this);
 389                 iterate_relocations(compiled,updater);
 390                 flush_icache_for(compiled);
 391         }
 392 }
 393
 394 void factor_vm::check_code_address(cell address)
 395 {
 396 #ifdef FACTOR_DEBUG
 397         assert(address >= code->seg->start && address < code->seg->end);
 398 #endif
 399 }
 400
 401 struct code_block_relocator {
 402         factor_vm *parent;
 403
 404         explicit code_block_relocator(factor_vm *parent_) : parent(parent_) {}
 405
 406         void operator()(relocation_entry rel, cell index, code_block *compiled)
 407         {
 408                 parent->relocate_code_block_step(rel,index,compiled);
 409         }
 410 };
 411
 412 /* Perform all fixups on a code block */
 413 void factor_vm::relocate_code_block(code_block *compiled)
 414 {
 415         code->needs_fixup.erase(compiled);
 416         code_block_relocator relocator(this);
 417         iterate_relocations(compiled,relocator);
 418         flush_icache_for(compiled);
 419 }
 420
 421 /* Fixup labels. This is done at compile time, not image load time */
 422 void factor_vm::fixup_labels(array *labels, code_block *compiled)
 423 {
 424         cell i;
 425         cell size = array_capacity(labels);
 426
 427         for(i = 0; i < size; i += 3)
 428         {
 429                 cell klass = untag_fixnum(array_nth(labels,i));
 430                 cell offset = untag_fixnum(array_nth(labels,i + 1));
 431                 cell target = untag_fixnum(array_nth(labels,i + 2));
 432
 433                 store_address_in_code_block(klass,
 434                         offset + (cell)(compiled + 1),
 435                         target + (cell)(compiled + 1));
 436         }
 437 }
 438
 439 /* Might GC */
 440 code_block *factor_vm::allot_code_block(cell size, cell type)
 441 {
 442         heap_block *block = code->heap_allot(size + sizeof(code_block),type);
 443
 444         /* If allocation failed, do a full GC and compact the code heap.
 445         A full GC that occurs as a result of the data heap filling up does not
 446         trigger a compaction. This setup ensures that most GCs do not compact
 447         the code heap, but if the code fills up, it probably means it will be
 448         fragmented after GC anyway, so its best to compact. */
 449         if(block == NULL)
 450         {
 451                 primitive_compact_gc();
 452                 block = code->heap_allot(size + sizeof(code_block),type);
 453
 454                 /* Insufficient room even after code GC, give up */
 455                 if(block == NULL)
 456                 {
 457                         cell used, total_free, max_free;
 458                         code->heap_usage(&used,&total_free,&max_free);
 459
 460                         print_string("Code heap stats:\n");
 461                         print_string("Used: "); print_cell(used); nl();
 462                         print_string("Total free space: "); print_cell(total_free); nl();
 463                         print_string("Largest free block: "); print_cell(max_free); nl();
 464                         fatal_error("Out of memory in add-compiled-block",0);
 465                 }
 466         }
 467
 468         return (code_block *)block;
 469 }
 470
 471 /* Might GC */
 472 code_block *factor_vm::add_code_block(cell type, cell code_, cell labels_, cell owner_, cell relocation_, cell literals_)
 473 {
 474         gc_root<byte_array> code(code_,this);
 475         gc_root<object> labels(labels_,this);
 476         gc_root<object> owner(owner_,this);
 477         gc_root<byte_array> relocation(relocation_,this);
 478         gc_root<array> literals(literals_,this);
 479
 480         cell code_length = align8(array_capacity(code.untagged()));
 481         code_block *compiled = allot_code_block(code_length,type);
 482
 483         compiled->owner = owner.value();
 484
 485         /* slight space optimization */
 486         if(relocation.type() == BYTE_ARRAY_TYPE && array_capacity(relocation.untagged()) == 0)
 487                 compiled->relocation = false_object;
 488         else
 489                 compiled->relocation = relocation.value();
 490
 491         if(literals.type() == ARRAY_TYPE && array_capacity(literals.untagged()) == 0)
 492                 compiled->literals = false_object;
 493         else
 494                 compiled->literals = literals.value();
 495
 496         /* code */
 497         memcpy(compiled + 1,code.untagged() + 1,code_length);
 498
 499         /* fixup labels */
 500         if(to_boolean(labels.value()))
 501                 fixup_labels(labels.as<array>().untagged(),compiled);
 502
 503         /* next time we do a minor GC, we have to scan the code heap for
 504         literals */
 505         this->code->write_barrier(compiled);
 506         this->code->needs_fixup.insert(compiled);
 507
 508         return compiled;
 509 }
 510
 511 }