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 /* Allocates memory */
 107 void quotation_jit::iterate_quotation()
 108 {
 109         bool stack_frame = stack_frame_p();
 110
 111         set_position(0);
 112
 113         if(stack_frame)
 114                 emit(parent_vm->userenv[JIT_PROLOG]);
 115
 116         cell i;
 117         cell length = array_capacity(elements.untagged());
 118         bool tail_call = false;
 119
 120         for(i = 0; i < length; i++)
 121         {
 122                 set_position(i);
 123
 124                 gc_root<object> obj(array_nth(elements.untagged(),i),parent_vm);
 125
 126                 switch(obj.type())
 127                 {
 128                 case WORD_TYPE:
 129                         /* Intrinsics */
 130                         if(obj.as<word>()->subprimitive != F)
 131                                 emit_subprimitive(obj.value());
 132                         /* The (execute) primitive is special-cased */
 133                         else if(obj.value() == parent_vm->userenv[JIT_EXECUTE_WORD])
 134                         {
 135                                 if(i == length - 1)
 136                                 {
 137                                         if(stack_frame) emit(parent_vm->userenv[JIT_EPILOG]);
 138                                         tail_call = true;
 139                                         emit(parent_vm->userenv[JIT_EXECUTE_JUMP]);
 140                                 }
 141                                 else
 142                                         emit(parent_vm->userenv[JIT_EXECUTE_CALL]);
 143                         }
 144                         /* Everything else */
 145                         else
 146                         {
 147                                 if(i == length - 1)
 148                                 {
 149                                         if(stack_frame) emit(parent_vm->userenv[JIT_EPILOG]);
 150                                         tail_call = true;
 151                                         /* Inline cache misses are special-cased.
 152                                            The calling convention for tail
 153                                            calls stores the address of the next
 154                                            instruction in a register. However,
 155                                            PIC miss stubs themselves tail-call
 156                                            the inline cache miss primitive, and
 157                                            we don't want to clobber the saved
 158                                            address. */
 159                                         if(obj.value() == parent_vm->userenv[PIC_MISS_WORD]
 160                                            || obj.value() == parent_vm->userenv[PIC_MISS_TAIL_WORD])
 161                                         {
 162                                                 word_special(obj.value());
 163                                         }
 164                                         else
 165                                         {
 166                                                 word_jump(obj.value());
 167                                         }
 168                                 }
 169                                 else
 170                                         word_call(obj.value());
 171                         }
 172                         break;
 173                 case WRAPPER_TYPE:
 174                         push(obj.as<wrapper>()->object);
 175                         break;
 176                 case FIXNUM_TYPE:
 177                         /* Primitive calls */
 178                         if(primitive_call_p(i,length))
 179                         {
 180                                 emit_with(parent_vm->userenv[JIT_PRIMITIVE],obj.value());
 181
 182                                 i++;
 183
 184                                 tail_call = true;
 185                         }
 186                         else
 187                                 push(obj.value());
 188                         break;
 189                 case QUOTATION_TYPE:
 190                         /* 'if' preceeded by two literal quotations (this is why if and ? are
 191                            mutually recursive in the library, but both still work) */
 192                         if(fast_if_p(i,length))
 193                         {
 194                                 if(stack_frame) emit(parent_vm->userenv[JIT_EPILOG]);
 195                                 tail_call = true;
 196
 197                                 if(compiling)
 198                                 {
 199                                         parent_vm->jit_compile(array_nth(elements.untagged(),i),relocate);
 200                                         parent_vm->jit_compile(array_nth(elements.untagged(),i + 1),relocate);
 201                                 }
 202
 203                                 literal(array_nth(elements.untagged(),i));
 204                                 literal(array_nth(elements.untagged(),i + 1));
 205                                 emit(parent_vm->userenv[JIT_IF]);
 206
 207                                 i += 2;
 208                         }
 209                         /* dip */
 210                         else if(fast_dip_p(i,length))
 211                         {
 212                                 if(compiling)
 213                                         parent_vm->jit_compile(obj.value(),relocate);
 214                                 emit_with(parent_vm->userenv[JIT_DIP],obj.value());
 215                                 i++;
 216                         }
 217                         /* 2dip */
 218                         else if(fast_2dip_p(i,length))
 219                         {
 220                                 if(compiling)
 221                                         parent_vm->jit_compile(obj.value(),relocate);
 222                                 emit_with(parent_vm->userenv[JIT_2DIP],obj.value());
 223                                 i++;
 224                         }
 225                         /* 3dip */
 226                         else if(fast_3dip_p(i,length))
 227                         {
 228                                 if(compiling)
 229                                         parent_vm->jit_compile(obj.value(),relocate);
 230                                 emit_with(parent_vm->userenv[JIT_3DIP],obj.value());
 231                                 i++;
 232                         }
 233                         else
 234                                 push(obj.value());
 235                         break;
 236                 case ARRAY_TYPE:
 237                         /* Method dispatch */
 238                         if(mega_lookup_p(i,length))
 239                         {
 240                                 emit_mega_cache_lookup(
 241                                         array_nth(elements.untagged(),i),
 242                                         untag_fixnum(array_nth(elements.untagged(),i + 1)),
 243                                         array_nth(elements.untagged(),i + 2));
 244                                 i += 3;
 245                                 tail_call = true;
 246                         }
 247                         /* Non-optimizing compiler ignores declarations */
 248                         else if(declare_p(i,length))
 249                                 i++;
 250                         else
 251                                 push(obj.value());
 252                         break;
 253                 default:
 254                         push(obj.value());
 255                         break;
 256                 }
 257         }
 258
 259         if(!tail_call)
 260         {
 261                 set_position(length);
 262
 263                 if(stack_frame)
 264                         emit(parent_vm->userenv[JIT_EPILOG]);
 265                 emit(parent_vm->userenv[JIT_RETURN]);
 266         }
 267 }
 268
 269 void factor_vm::set_quot_xt(quotation *quot, code_block *code)
 270 {
 271         if(code->type != QUOTATION_TYPE)
 272                 critical_error("Bad param to set_quot_xt",(cell)code);
 273
 274         quot->code = code;
 275         quot->xt = code->xt();
 276 }
 277
 278 /* Allocates memory */
 279 void factor_vm::jit_compile(cell quot_, bool relocating)
 280 {
 281         gc_root<quotation> quot(quot_,this);
 282         if(quot->code) return;
 283
 284         quotation_jit compiler(quot.value(),true,relocating,this);
 285         compiler.iterate_quotation();
 286
 287         code_block *compiled = compiler.to_code_block();
 288         set_quot_xt(quot.untagged(),compiled);
 289
 290         if(relocating) relocate_code_block(compiled);
 291 }
 292
 293 inline void factor_vm::primitive_jit_compile()
 294 {
 295         jit_compile(dpop(),true);
 296 }
 297
 298 PRIMITIVE(jit_compile)
 299 {
 300         PRIMITIVE_GETVM()->primitive_jit_compile();
 301 }
 302
 303 /* push a new quotation on the stack */
 304 inline void factor_vm::primitive_array_to_quotation()
 305 {
 306         quotation *quot = allot<quotation>(sizeof(quotation));
 307         quot->array = dpeek();
 308         quot->cached_effect = F;
 309         quot->cache_counter = F;
 310         quot->xt = (void *)lazy_jit_compile;
 311         quot->code = NULL;
 312         drepl(tag<quotation>(quot));
 313 }
 314
 315 PRIMITIVE(array_to_quotation)
 316 {
 317         PRIMITIVE_GETVM()->primitive_array_to_quotation();
 318 }
 319
 320 inline void factor_vm::primitive_quotation_xt()
 321 {
 322         quotation *quot = untag_check<quotation>(dpeek());
 323         drepl(allot_cell((cell)quot->xt));
 324 }
 325
 326 PRIMITIVE(quotation_xt)
 327 {
 328         PRIMITIVE_GETVM()->primitive_quotation_xt();
 329 }
 330
 331 void factor_vm::compile_all_words()
 332 {
 333         gc_root<array> words(find_all_words(),this);
 334
 335         cell i;
 336         cell length = array_capacity(words.untagged());
 337         for(i = 0; i < length; i++)
 338         {
 339                 gc_root<word> word(array_nth(words.untagged(),i),this);
 340
 341                 if(!word->code || !word_optimized_p(word.untagged()))
 342                         jit_compile_word(word.value(),word->def,false);
 343
 344                 update_word_xt(word.value());
 345
 346         }
 347
 348         iterate_code_heap(factor::relocate_code_block);
 349 }
 350
 351 /* Allocates memory */
 352 fixnum factor_vm::quot_code_offset_to_scan(cell quot_, cell offset)
 353 {
 354         gc_root<quotation> quot(quot_,this);
 355         gc_root<array> array(quot->array,this);
 356
 357         quotation_jit compiler(quot.value(),false,false,this);
 358         compiler.compute_position(offset);
 359         compiler.iterate_quotation();
 360
 361         return compiler.get_position();
 362 }
 363
 364 cell factor_vm::lazy_jit_compile_impl(cell quot_, stack_frame *stack)
 365 {
 366         gc_root<quotation> quot(quot_,this);
 367         stack_chain->callstack_top = stack;
 368         jit_compile(quot.value(),true);
 369         return quot.value();
 370 }
 371
 372 VM_ASM_API_OVERFLOW cell lazy_jit_compile_impl(cell quot_, stack_frame *stack, factor_vm *myvm)
 373 {
 374         ASSERTVM();
 375         return VM_PTR->lazy_jit_compile_impl(quot_,stack);
 376 }
 377
 378 inline void factor_vm::primitive_quot_compiled_p()
 379 {
 380         tagged<quotation> quot(dpop());
 381         quot.untag_check(this);
 382         dpush(tag_boolean(quot->code != NULL));
 383 }
 384
 385 PRIMITIVE(quot_compiled_p)
 386 {
 387         PRIMITIVE_GETVM()->primitive_quot_compiled_p();
 388 }
 389
 390 }