vm/code_block.cpp

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