vm/code_block.cpp

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