vm/quotations.cpp

   1 #include "master.hpp"
   2
   3 namespace factor
   4 {
   5
   6 /* Simple non-optimizing compiler.
   7
   8 This is one of the two compilers implementing Factor; the second one is written
   9 in Factor and performs advanced optimizations. See core/compiler/compiler.factor.
  10
  11 The non-optimizing compiler compiles a quotation at a time by concatenating
  12 machine code chunks; prolog, epilog, call word, jump to word, etc. These machine
  13 code chunks are generated from Factor code in core/cpu/.../bootstrap.factor.
  14
  15 Calls to words and constant quotations (referenced by conditionals and dips)
  16 are direct jumps to machine code blocks. Literals are also referenced directly
  17 without going through the literal table.
  18
  19 It actually does do a little bit of very simple optimization:
  20
  21 1) Tail call optimization.
  22
  23 2) If a quotation is determined to not call any other words (except for a few
  24 special words which are open-coded, see below), then no prolog/epilog is
  25 generated.
  26
  27 3) When in tail position and immediately preceded by literal arguments, the
  28 'if' is generated inline, instead of as a call to the 'if' word.
  29
  30 4) When preceded by a quotation, calls to 'dip', '2dip' and '3dip' are
  31 open-coded as retain stack manipulation surrounding a subroutine call.
  32
  33 5) Sub-primitives are primitive words which are implemented in assembly and not
  34 in the VM. They are open-coded and no subroutine call is generated. This
  35 includes stack shufflers, some fixnum arithmetic words, and words such as tag,
  36 slot and eq?. A primitive call is relatively expensive (two subroutine calls)
  37 so this results in a big speedup for relatively little effort. */
  38
  39 bool quotation_jit::primitive_call_p(cell i, cell length)
  40 {
  41         return (i + 2) == length && array_nth(elements.untagged(),i + 1) == parent_vm->userenv[JIT_PRIMITIVE_WORD];
  42 }
  43
  44 bool quotation_jit::fast_if_p(cell i, cell length)
  45 {
  46         return (i + 3) == length
  47                 && tagged<object>(array_nth(elements.untagged(),i + 1)).type_p(QUOTATION_TYPE)
  48                 && array_nth(elements.untagged(),i + 2) == parent_vm->userenv[JIT_IF_WORD];
  49 }
  50
  51 bool quotation_jit::fast_dip_p(cell i, cell length)
  52 {
  53         return (i + 2) <= length && array_nth(elements.untagged(),i + 1) == parent_vm->userenv[JIT_DIP_WORD];
  54 }
  55
  56 bool quotation_jit::fast_2dip_p(cell i, cell length)
  57 {
  58         return (i + 2) <= length && array_nth(elements.untagged(),i + 1) == parent_vm->userenv[JIT_2DIP_WORD];
  59 }
  60
  61 bool quotation_jit::fast_3dip_p(cell i, cell length)
  62 {
  63         return (i + 2) <= length && array_nth(elements.untagged(),i + 1) == parent_vm->userenv[JIT_3DIP_WORD];
  64 }
  65
  66 bool quotation_jit::mega_lookup_p(cell i, cell length)
  67 {
  68         return (i + 4) <= length
  69                 && tagged<object>(array_nth(elements.untagged(),i + 1)).type_p(FIXNUM_TYPE)
  70                 && tagged<object>(array_nth(elements.untagged(),i + 2)).type_p(ARRAY_TYPE)
  71                 && array_nth(elements.untagged(),i + 3) == parent_vm->userenv[MEGA_LOOKUP_WORD];
  72 }
  73
  74 bool quotation_jit::declare_p(cell i, cell length)
  75 {
  76         return (i + 2) <= length
  77                 && array_nth(elements.untagged(),i + 1) == parent_vm->userenv[JIT_DECLARE_WORD];
  78 }
  79
  80 bool quotation_jit::stack_frame_p()
  81 {
  82         fixnum length = array_capacity(elements.untagged());
  83         fixnum i;
  84
  85         for(i = 0; i < length - 1; i++)
  86         {
  87                 cell obj = array_nth(elements.untagged(),i);
  88                 switch(tagged<object>(obj).type())
  89                 {
  90                 case WORD_TYPE:
  91                         if(parent_vm->untag<word>(obj)->subprimitive == F)
  92                                 return true;
  93                         break;
  94                 case QUOTATION_TYPE:
  95                         if(fast_dip_p(i,length) || fast_2dip_p(i,length) || fast_3dip_p(i,length))
  96                                 return true;
  97                         break;
  98                 default:
  99                         break;
 100                 }
 101         }
 102
 103         return false;
 104 }
 105
 106 bool quotation_jit::trivial_quotation_p(array *elements)
 107 {
 108         return array_capacity(elements) == 1 && tagged<object>(array_nth(elements,0)).type_p(WORD_TYPE);
 109 }
 110
 111 void quotation_jit::emit_quot(cell quot_)
 112 {
 113         gc_root<quotation> quot(quot_,parent_vm);
 114
 115         array *elements = parent_vm->untag<array>(quot->array);
 116
 117         /* If the quotation consists of a single word, compile a direct call
 118         to the word. */
 119         if(trivial_quotation_p(elements))
 120                 literal(array_nth(elements,0));
 121         else
 122         {
 123                 if(compiling) parent_vm->jit_compile(quot.value(),relocate);
 124                 literal(quot.value());
 125         }
 126 }
 127
 128 /* Allocates memory */
 129 void quotation_jit::iterate_quotation()
 130 {
 131         bool stack_frame = stack_frame_p();
 132
 133         set_position(0);
 134
 135         if(stack_frame)
 136                 emit(parent_vm->userenv[JIT_PROLOG]);
 137
 138         cell i;
 139         cell length = array_capacity(elements.untagged());
 140         bool tail_call = false;
 141
 142         for(i = 0; i < length; i++)
 143         {
 144                 set_position(i);
 145
 146                 gc_root<object> obj(array_nth(elements.untagged(),i),parent_vm);
 147
 148                 switch(obj.type())
 149                 {
 150                 case WORD_TYPE:
 151                         /* Intrinsics */
 152                         if(obj.as<word>()->subprimitive != F)
 153                                 emit_subprimitive(obj.value());
 154                         /* The (execute) primitive is special-cased */
 155                         else if(obj.value() == parent_vm->userenv[JIT_EXECUTE_WORD])
 156                         {
 157                                 if(i == length - 1)
 158                                 {
 159                                         if(stack_frame) emit(parent_vm->userenv[JIT_EPILOG]);
 160                                         tail_call = true;
 161                                         emit(parent_vm->userenv[JIT_EXECUTE_JUMP]);
 162                                 }
 163                                 else
 164                                         emit(parent_vm->userenv[JIT_EXECUTE_CALL]);
 165                         }
 166                         /* Everything else */
 167                         else
 168                         {
 169                                 if(i == length - 1)
 170                                 {
 171                                         if(stack_frame) emit(parent_vm->userenv[JIT_EPILOG]);
 172                                         tail_call = true;
 173                                         /* Inline cache misses are special-cased.
 174                                            The calling convention for tail
 175                                            calls stores the address of the next
 176                                            instruction in a register. However,
 177                                            PIC miss stubs themselves tail-call
 178                                            the inline cache miss primitive, and
 179                                            we don't want to clobber the saved
 180                                            address. */
 181                                         if(obj.value() == parent_vm->userenv[PIC_MISS_WORD]
 182                                            || obj.value() == parent_vm->userenv[PIC_MISS_TAIL_WORD])
 183                                         {
 184                                                 word_special(obj.value());
 185                                         }
 186                                         else
 187                                         {
 188                                                 word_jump(obj.value());
 189                                         }
 190                                 }
 191                                 else
 192                                         word_call(obj.value());
 193                         }
 194                         break;
 195                 case WRAPPER_TYPE:
 196                         push(obj.as<wrapper>()->object);
 197                         break;
 198                 case FIXNUM_TYPE:
 199                         /* Primitive calls */
 200                         if(primitive_call_p(i,length))
 201                         {
 202                                 emit_with(parent_vm->userenv[JIT_PRIMITIVE],obj.value());
 203
 204                                 i++;
 205
 206                                 tail_call = true;
 207                         }
 208                         else
 209                                 push(obj.value());
 210                         break;
 211                 case QUOTATION_TYPE:
 212                         /* 'if' preceeded by two literal quotations (this is why if and ? are
 213                            mutually recursive in the library, but both still work) */
 214                         if(fast_if_p(i,length))
 215                         {
 216                                 if(stack_frame) emit(parent_vm->userenv[JIT_EPILOG]);
 217                                 tail_call = true;
 218
 219                                 emit_quot(array_nth(elements.untagged(),i));
 220                                 emit_quot(array_nth(elements.untagged(),i + 1));
 221                                 emit(parent_vm->userenv[JIT_IF]);
 222
 223                                 i += 2;
 224                         }
 225                         /* dip */
 226                         else if(fast_dip_p(i,length))
 227                         {
 228                                 emit_quot(obj.value());
 229                                 emit(parent_vm->userenv[JIT_DIP]);
 230                                 i++;
 231                         }
 232                         /* 2dip */
 233                         else if(fast_2dip_p(i,length))
 234                         {
 235                                 emit_quot(obj.value());
 236                                 emit(parent_vm->userenv[JIT_2DIP]);
 237                                 i++;
 238                         }
 239                         /* 3dip */
 240                         else if(fast_3dip_p(i,length))
 241                         {
 242                                 emit_quot(obj.value());
 243                                 emit(parent_vm->userenv[JIT_3DIP]);
 244                                 i++;
 245                         }
 246                         else
 247                                 push(obj.value());
 248                         break;
 249                 case ARRAY_TYPE:
 250                         /* Method dispatch */
 251                         if(mega_lookup_p(i,length))
 252                         {
 253                                 emit_mega_cache_lookup(
 254                                         array_nth(elements.untagged(),i),
 255                                         untag_fixnum(array_nth(elements.untagged(),i + 1)),
 256                                         array_nth(elements.untagged(),i + 2));
 257                                 i += 3;
 258                                 tail_call = true;
 259                         }
 260                         /* Non-optimizing compiler ignores declarations */
 261                         else if(declare_p(i,length))
 262                                 i++;
 263                         else
 264                                 push(obj.value());
 265                         break;
 266                 default:
 267                         push(obj.value());
 268                         break;
 269                 }
 270         }
 271
 272         if(!tail_call)
 273         {
 274                 set_position(length);
 275
 276                 if(stack_frame)
 277                         emit(parent_vm->userenv[JIT_EPILOG]);
 278                 emit(parent_vm->userenv[JIT_RETURN]);
 279         }
 280 }
 281
 282 void factor_vm::set_quot_xt(quotation *quot, code_block *code)
 283 {
 284         if(code->type() != QUOTATION_TYPE)
 285                 critical_error("Bad param to set_quot_xt",(cell)code);
 286
 287         quot->code = code;
 288         quot->xt = code->xt();
 289 }
 290
 291 /* Allocates memory */
 292 void factor_vm::jit_compile(cell quot_, bool relocating)
 293 {
 294         gc_root<quotation> quot(quot_,this);
 295         if(quot->code) return;
 296
 297         quotation_jit compiler(quot.value(),true,relocating,this);
 298         compiler.iterate_quotation();
 299
 300         code_block *compiled = compiler.to_code_block();
 301         set_quot_xt(quot.untagged(),compiled);
 302
 303         if(relocating) relocate_code_block(compiled);
 304 }
 305
 306 void factor_vm::primitive_jit_compile()
 307 {
 308         jit_compile(dpop(),true);
 309 }
 310
 311 /* push a new quotation on the stack */
 312 void factor_vm::primitive_array_to_quotation()
 313 {
 314         quotation *quot = allot<quotation>(sizeof(quotation));
 315         quot->array = dpeek();
 316         quot->cached_effect = F;
 317         quot->cache_counter = F;
 318         quot->xt = (void *)lazy_jit_compile;
 319         quot->code = NULL;
 320         drepl(tag<quotation>(quot));
 321 }
 322
 323 void factor_vm::primitive_quotation_xt()
 324 {
 325         quotation *quot = untag_check<quotation>(dpeek());
 326         drepl(allot_cell((cell)quot->xt));
 327 }
 328
 329 void factor_vm::compile_all_words()
 330 {
 331         gc_root<array> words(find_all_words(),this);
 332
 333         cell i;
 334         cell length = array_capacity(words.untagged());
 335         for(i = 0; i < length; i++)
 336         {
 337                 gc_root<word> word(array_nth(words.untagged(),i),this);
 338
 339                 if(!word->code || !word_optimized_p(word.untagged()))
 340                         jit_compile_word(word.value(),word->def,false);
 341
 342                 update_word_xt(word.value());
 343
 344         }
 345
 346         update_code_heap_words();
 347 }
 348
 349 /* Allocates memory */
 350 fixnum factor_vm::quot_code_offset_to_scan(cell quot_, cell offset)
 351 {
 352         gc_root<quotation> quot(quot_,this);
 353         gc_root<array> array(quot->array,this);
 354
 355         quotation_jit compiler(quot.value(),false,false,this);
 356         compiler.compute_position(offset);
 357         compiler.iterate_quotation();
 358
 359         return compiler.get_position();
 360 }
 361
 362 cell factor_vm::lazy_jit_compile_impl(cell quot_, stack_frame *stack)
 363 {
 364         gc_root<quotation> quot(quot_,this);
 365         stack_chain->callstack_top = stack;
 366         jit_compile(quot.value(),true);
 367         return quot.value();
 368 }
 369
 370 VM_ASM_API cell lazy_jit_compile_impl(cell quot_, stack_frame *stack, factor_vm *myvm)
 371 {
 372         return myvm->lazy_jit_compile_impl(quot_,stack);
 373 }
 374
 375 void factor_vm::primitive_quot_compiled_p()
 376 {
 377         tagged<quotation> quot(dpop());
 378         quot.untag_check(this);
 379         dpush(tag_boolean(quot->code != NULL));
 380 }
 381
 382 }