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