vm/code_block.c

   1 #include "master.h"
   2
   3 void flush_icache_for(F_CODE_BLOCK *compiled)
   4 {
   5         CELL start = (CELL)(compiled + 1);
   6         flush_icache(start,compiled->code_length);
   7 }
   8
   9 void iterate_relocations(F_CODE_BLOCK *compiled, RELOCATION_ITERATOR iter)
  10 {
  11         if(compiled->relocation != F)
  12         {
  13                 F_BYTE_ARRAY *relocation = untag_object(compiled->relocation);
  14
  15                 F_REL *rel = (F_REL *)(relocation + 1);
  16                 F_REL *rel_end = (F_REL *)((char *)rel + byte_array_capacity(relocation));
  17
  18                 while(rel < rel_end)
  19                 {
  20                         iter(rel,compiled);
  21                         rel++;
  22                 }
  23         }
  24 }
  25
  26 /* Store a 32-bit value into a PowerPC LIS/ORI sequence */
  27 INLINE void store_address_2_2(CELL cell, CELL value)
  28 {
  29         put(cell - CELLS,((get(cell - CELLS) & ~0xffff) | ((value >> 16) & 0xffff)));
  30         put(cell,((get(cell) & ~0xffff) | (value & 0xffff)));
  31 }
  32
  33 /* Store a value into a bitfield of a PowerPC instruction */
  34 INLINE void store_address_masked(CELL cell, F_FIXNUM value, CELL mask, F_FIXNUM shift)
  35 {
  36         /* This is unaccurate but good enough */
  37         F_FIXNUM test = (F_FIXNUM)mask >> 1;
  38         if(value <= -test || value >= test)
  39                 critical_error("Value does not fit inside relocation",0);
  40
  41         u32 original = *(u32*)cell;
  42         original &= ~mask;
  43         *(u32*)cell = (original | ((value >> shift) & mask));
  44 }
  45
  46 /* Perform a fixup on a code block */
  47 void store_address_in_code_block(CELL class, CELL offset, F_FIXNUM absolute_value)
  48 {
  49         F_FIXNUM relative_value = absolute_value - offset;
  50
  51         switch(class)
  52         {
  53         case RC_ABSOLUTE_CELL:
  54                 put(offset,absolute_value);
  55                 break;
  56         case RC_ABSOLUTE:
  57                 *(u32*)offset = absolute_value;
  58                 break;
  59         case RC_RELATIVE:
  60                 *(u32*)offset = relative_value - sizeof(u32);
  61                 break;
  62         case RC_ABSOLUTE_PPC_2_2:
  63                 store_address_2_2(offset,absolute_value);
  64                 break;
  65         case RC_RELATIVE_PPC_2:
  66                 store_address_masked(offset,relative_value,REL_RELATIVE_PPC_2_MASK,0);
  67                 break;
  68         case RC_RELATIVE_PPC_3:
  69                 store_address_masked(offset,relative_value,REL_RELATIVE_PPC_3_MASK,0);
  70                 break;
  71         case RC_RELATIVE_ARM_3:
  72                 store_address_masked(offset,relative_value - CELLS * 2,
  73                         REL_RELATIVE_ARM_3_MASK,2);
  74                 break;
  75         case RC_INDIRECT_ARM:
  76                 store_address_masked(offset,relative_value - CELLS,
  77                         REL_INDIRECT_ARM_MASK,0);
  78                 break;
  79         case RC_INDIRECT_ARM_PC:
  80                 store_address_masked(offset,relative_value - CELLS * 2,
  81                         REL_INDIRECT_ARM_MASK,0);
  82                 break;
  83         default:
  84                 critical_error("Bad rel class",class);
  85                 break;
  86         }
  87 }
  88
  89 void update_literal_references_step(F_REL *rel, F_CODE_BLOCK *compiled)
  90 {
  91         if(REL_TYPE(rel) == RT_IMMEDIATE)
  92         {
  93                 CELL offset = rel->offset + (CELL)(compiled + 1);
  94                 F_ARRAY *literals = untag_object(compiled->literals);
  95                 F_FIXNUM absolute_value = array_nth(literals,REL_ARGUMENT(rel));
  96                 store_address_in_code_block(REL_CLASS(rel),offset,absolute_value);
  97         }
  98 }
  99
 100 /* Update pointers to literals from compiled code. */
 101 void update_literal_references(F_CODE_BLOCK *compiled)
 102 {
 103         iterate_relocations(compiled,update_literal_references_step);
 104         flush_icache_for(compiled);
 105 }
 106
 107 /* Copy all literals referenced from a code block to newspace. Only for
 108 aging and nursery collections */
 109 void copy_literal_references(F_CODE_BLOCK *compiled)
 110 {
 111         if(collecting_gen >= compiled->last_scan)
 112         {
 113                 if(collecting_accumulation_gen_p())
 114                         compiled->last_scan = collecting_gen;
 115                 else
 116                         compiled->last_scan = collecting_gen + 1;
 117
 118                 /* initialize chase pointer */
 119                 CELL scan = newspace->here;
 120
 121                 copy_handle(&compiled->literals);
 122                 copy_handle(&compiled->relocation);
 123
 124                 /* do some tracing so that all reachable literals are now
 125                 at their final address */
 126                 copy_reachable_objects(scan,&newspace->here);
 127
 128                 update_literal_references(compiled);
 129         }
 130 }
 131
 132 CELL object_xt(CELL obj)
 133 {
 134         if(type_of(obj) == WORD_TYPE)
 135                 return (CELL)untag_word(obj)->xt;
 136         else
 137                 return (CELL)untag_quotation(obj)->xt;
 138 }
 139
 140 void update_word_references_step(F_REL *rel, F_CODE_BLOCK *compiled)
 141 {
 142         if(REL_TYPE(rel) == RT_XT)
 143         {
 144                 CELL offset = rel->offset + (CELL)(compiled + 1);
 145                 F_ARRAY *literals = untag_object(compiled->literals);
 146                 CELL xt = object_xt(array_nth(literals,REL_ARGUMENT(rel)));
 147                 store_address_in_code_block(REL_CLASS(rel),offset,xt);
 148         }
 149 }
 150
 151 /* Relocate new code blocks completely; updating references to literals,
 152 dlsyms, and words. For all other words in the code heap, we only need
 153 to update references to other words, without worrying about literals
 154 or dlsyms. */
 155 void update_word_references(F_CODE_BLOCK *compiled)
 156 {
 157         if(compiled->needs_fixup)
 158                 relocate_code_block(compiled);
 159         else
 160         {
 161                 iterate_relocations(compiled,update_word_references_step);
 162                 flush_icache_for(compiled);
 163         }
 164 }
 165
 166 /* Update references to words. This is done after a new code block
 167 is added to the heap. */
 168
 169 /* Mark all literals referenced from a word XT. Only for tenured
 170 collections */
 171 void mark_code_block(F_CODE_BLOCK *compiled)
 172 {
 173         mark_block(compiled_to_block(compiled));
 174
 175         copy_handle(&compiled->literals);
 176         copy_handle(&compiled->relocation);
 177
 178         flush_icache_for(compiled);
 179 }
 180
 181 /* References to undefined symbols are patched up to call this function on
 182 image load */
 183 void undefined_symbol(void)
 184 {
 185         general_error(ERROR_UNDEFINED_SYMBOL,F,F,NULL);
 186 }
 187
 188 /* Look up an external library symbol referenced by a compiled code block */
 189 void *get_rel_symbol(F_REL *rel, F_ARRAY *literals)
 190 {
 191         CELL arg = REL_ARGUMENT(rel);
 192         CELL symbol = array_nth(literals,arg);
 193         CELL library = array_nth(literals,arg + 1);
 194
 195         F_DLL *dll = (library == F ? NULL : untag_dll(library));
 196
 197         if(dll != NULL && !dll->dll)
 198                 return undefined_symbol;
 199
 200         if(type_of(symbol) == BYTE_ARRAY_TYPE)
 201         {
 202                 F_SYMBOL *name = alien_offset(symbol);
 203                 void *sym = ffi_dlsym(dll,name);
 204
 205                 if(sym)
 206                         return sym;
 207         }
 208         else if(type_of(symbol) == ARRAY_TYPE)
 209         {
 210                 CELL i;
 211                 F_ARRAY *names = untag_object(symbol);
 212                 for(i = 0; i < array_capacity(names); i++)
 213                 {
 214                         F_SYMBOL *name = alien_offset(array_nth(names,i));
 215                         void *sym = ffi_dlsym(dll,name);
 216
 217                         if(sym)
 218                                 return sym;
 219                 }
 220         }
 221
 222         return undefined_symbol;
 223 }
 224
 225 /* Compute an address to store at a relocation */
 226 void relocate_code_block_step(F_REL *rel, F_CODE_BLOCK *compiled)
 227 {
 228         CELL offset = rel->offset + (CELL)(compiled + 1);
 229         F_ARRAY *literals = untag_object(compiled->literals);
 230         F_FIXNUM absolute_value;
 231
 232         switch(REL_TYPE(rel))
 233         {
 234         case RT_PRIMITIVE:
 235                 absolute_value = (CELL)primitives[REL_ARGUMENT(rel)];
 236                 break;
 237         case RT_DLSYM:
 238                 absolute_value = (CELL)get_rel_symbol(rel,literals);
 239                 break;
 240         case RT_IMMEDIATE:
 241                 absolute_value = array_nth(literals,REL_ARGUMENT(rel));
 242                 break;
 243         case RT_XT:
 244                 absolute_value = object_xt(array_nth(literals,REL_ARGUMENT(rel)));
 245                 break;
 246         case RT_HERE:
 247                 absolute_value = rel->offset + (CELL)(compiled + 1) + (short)REL_ARGUMENT(rel);
 248                 break;
 249         case RT_LABEL:
 250                 absolute_value = (CELL)(compiled + 1) + REL_ARGUMENT(rel);
 251                 break;
 252         case RT_STACK_CHAIN:
 253                 absolute_value = (CELL)&stack_chain;
 254                 break;
 255         default:
 256                 critical_error("Bad rel type",rel->type);
 257                 return; /* Can't happen */
 258         }
 259
 260         store_address_in_code_block(REL_CLASS(rel),offset,absolute_value);
 261 }
 262
 263 /* Perform all fixups on a code block */
 264 void relocate_code_block(F_CODE_BLOCK *compiled)
 265 {
 266         compiled->last_scan = NURSERY;
 267         compiled->needs_fixup = false;
 268         iterate_relocations(compiled,relocate_code_block_step);
 269         flush_icache_for(compiled);
 270 }
 271
 272 /* Fixup labels. This is done at compile time, not image load time */
 273 void fixup_labels(F_ARRAY *labels, CELL code_format, F_CODE_BLOCK *compiled)
 274 {
 275         CELL i;
 276         CELL size = array_capacity(labels);
 277
 278         for(i = 0; i < size; i += 3)
 279         {
 280                 CELL class = to_fixnum(array_nth(labels,i));
 281                 CELL offset = to_fixnum(array_nth(labels,i + 1));
 282                 CELL target = to_fixnum(array_nth(labels,i + 2));
 283
 284                 store_address_in_code_block(class,
 285                         offset + (CELL)(compiled + 1),
 286                         target + (CELL)(compiled + 1));
 287         }
 288 }
 289
 290 /* Write a sequence of integers to memory, with 'format' bytes per integer */
 291 void deposit_integers(CELL here, F_ARRAY *array, CELL format)
 292 {
 293         CELL count = array_capacity(array);
 294         CELL i;
 295
 296         for(i = 0; i < count; i++)
 297         {
 298                 F_FIXNUM value = to_fixnum(array_nth(array,i));
 299                 if(format == 1)
 300                         bput(here + i,value);
 301                 else if(format == sizeof(unsigned int))
 302                         *(unsigned int *)(here + format * i) = value;
 303                 else if(format == sizeof(CELL))
 304                         *(CELL *)(here + format * i) = value;
 305                 else
 306                         critical_error("Bad format in deposit_integers()",format);
 307         }
 308 }
 309
 310 bool stack_traces_p(void)
 311 {
 312         return to_boolean(userenv[STACK_TRACES_ENV]);
 313 }
 314
 315 CELL compiled_code_format(void)
 316 {
 317         return untag_fixnum_fast(userenv[JIT_CODE_FORMAT]);
 318 }
 319
 320 /* Might GC */
 321 void *allot_code_block(CELL size)
 322 {
 323         void *start = heap_allot(&code_heap,size);
 324
 325         /* If allocation failed, do a code GC */
 326         if(start == NULL)
 327         {
 328                 gc();
 329                 start = heap_allot(&code_heap,size);
 330
 331                 /* Insufficient room even after code GC, give up */
 332                 if(start == NULL)
 333                 {
 334                         CELL used, total_free, max_free;
 335                         heap_usage(&code_heap,&used,&total_free,&max_free);
 336
 337                         print_string("Code heap stats:\n");
 338                         print_string("Used: "); print_cell(used); nl();
 339                         print_string("Total free space: "); print_cell(total_free); nl();
 340                         print_string("Largest free block: "); print_cell(max_free); nl();
 341                         fatal_error("Out of memory in add-compiled-block",0);
 342                 }
 343         }
 344
 345         return start;
 346 }
 347
 348 /* Might GC */
 349 F_CODE_BLOCK *add_compiled_block(
 350         CELL type,
 351         F_ARRAY *code,
 352         F_ARRAY *labels,
 353         CELL relocation,
 354         CELL literals)
 355 {
 356         CELL code_format = compiled_code_format();
 357         CELL code_length = align8(array_capacity(code) * code_format);
 358
 359         REGISTER_ROOT(literals);
 360         REGISTER_ROOT(relocation);
 361         REGISTER_UNTAGGED(code);
 362         REGISTER_UNTAGGED(labels);
 363
 364         F_CODE_BLOCK *compiled = allot_code_block(sizeof(F_CODE_BLOCK) + code_length);
 365
 366         UNREGISTER_UNTAGGED(labels);
 367         UNREGISTER_UNTAGGED(code);
 368         UNREGISTER_ROOT(relocation);
 369         UNREGISTER_ROOT(literals);
 370
 371         /* compiled header */
 372         compiled->type = type;
 373         compiled->last_scan = NURSERY;
 374         compiled->needs_fixup = true;
 375         compiled->code_length = code_length;
 376         compiled->literals = literals;
 377         compiled->relocation = relocation;
 378
 379         /* code */
 380         deposit_integers((CELL)(compiled + 1),code,code_format);
 381
 382         /* fixup labels */
 383         if(labels) fixup_labels(labels,code_format,compiled);
 384
 385         /* next time we do a minor GC, we have to scan the code heap for
 386         literals */
 387         last_code_heap_scan = NURSERY;
 388
 389         return compiled;
 390 }