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 basis/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 basis/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 void quotation_jit::init_quotation(cell quot)
  40 {
  41         elements = untag<quotation>(quot)->array;
  42 }
  43
  44 bool quotation_jit::primitive_call_p(cell i, cell length)
  45 {
  46         return (i + 2) == length && array_nth(elements.untagged(),i + 1) == parent->special_objects[JIT_PRIMITIVE_WORD];
  47 }
  48
  49 bool quotation_jit::fast_if_p(cell i, cell length)
  50 {
  51         return (i + 3) == length
  52                 && tagged<object>(array_nth(elements.untagged(),i + 1)).type_p(QUOTATION_TYPE)
  53                 && array_nth(elements.untagged(),i + 2) == parent->special_objects[JIT_IF_WORD];
  54 }
  55
  56 bool quotation_jit::fast_dip_p(cell i, cell length)
  57 {
  58         return (i + 2) <= length && array_nth(elements.untagged(),i + 1) == parent->special_objects[JIT_DIP_WORD];
  59 }
  60
  61 bool quotation_jit::fast_2dip_p(cell i, cell length)
  62 {
  63         return (i + 2) <= length && array_nth(elements.untagged(),i + 1) == parent->special_objects[JIT_2DIP_WORD];
  64 }
  65
  66 bool quotation_jit::fast_3dip_p(cell i, cell length)
  67 {
  68         return (i + 2) <= length && array_nth(elements.untagged(),i + 1) == parent->special_objects[JIT_3DIP_WORD];
  69 }
  70
  71 bool quotation_jit::mega_lookup_p(cell i, cell length)
  72 {
  73         return (i + 4) <= length
  74                 && tagged<object>(array_nth(elements.untagged(),i + 1)).type_p(FIXNUM_TYPE)
  75                 && tagged<object>(array_nth(elements.untagged(),i + 2)).type_p(ARRAY_TYPE)
  76                 && array_nth(elements.untagged(),i + 3) == parent->special_objects[MEGA_LOOKUP_WORD];
  77 }
  78
  79 bool quotation_jit::declare_p(cell i, cell length)
  80 {
  81         return (i + 2) <= length
  82                 && array_nth(elements.untagged(),i + 1) == parent->special_objects[JIT_DECLARE_WORD];
  83 }
  84
  85 bool quotation_jit::stack_frame_p()
  86 {
  87         fixnum length = array_capacity(elements.untagged());
  88         fixnum i;
  89
  90         for(i = 0; i < length - 1; i++)
  91         {
  92                 cell obj = array_nth(elements.untagged(),i);
  93                 switch(tagged<object>(obj).type())
  94                 {
  95                 case WORD_TYPE:
  96                         if(!to_boolean(untag<word>(obj)->subprimitive))
  97                                 return true;
  98                         break;
  99                 case QUOTATION_TYPE:
 100                         if(fast_dip_p(i,length) || fast_2dip_p(i,length) || fast_3dip_p(i,length))
 101                                 return true;
 102                         break;
 103                 default:
 104                         break;
 105                 }
 106         }
 107
 108         return false;
 109 }
 110
 111 bool quotation_jit::trivial_quotation_p(array *elements)
 112 {
 113         return array_capacity(elements) == 1 && tagged<object>(array_nth(elements,0)).type_p(WORD_TYPE);
 114 }
 115
 116 void quotation_jit::emit_quot(cell quot_)
 117 {
 118         data_root<quotation> quot(quot_,parent);
 119
 120         array *elements = untag<array>(quot->array);
 121
 122         /* If the quotation consists of a single word, compile a direct call
 123         to the word. */
 124         if(trivial_quotation_p(elements))
 125                 literal(array_nth(elements,0));
 126         else
 127         {
 128                 if(compiling) parent->jit_compile_quot(quot.value(),relocate);
 129                 literal(quot.value());
 130         }
 131 }
 132
 133 /* Allocates memory */
 134 void quotation_jit::iterate_quotation()
 135 {
 136         bool stack_frame = stack_frame_p();
 137
 138         set_position(0);
 139
 140         if(stack_frame)
 141                 emit(parent->special_objects[JIT_PROLOG]);
 142
 143         cell i;
 144         cell length = array_capacity(elements.untagged());
 145         bool tail_call = false;
 146
 147         for(i = 0; i < length; i++)
 148         {
 149                 set_position(i);
 150
 151                 data_root<object> obj(array_nth(elements.untagged(),i),parent);
 152
 153                 switch(obj.type())
 154                 {
 155                 case WORD_TYPE:
 156                         /* Intrinsics */
 157                         if(to_boolean(obj.as<word>()->subprimitive))
 158                                 emit_subprimitive(obj.value());
 159                         /* The (execute) primitive is special-cased */
 160                         else if(obj.value() == parent->special_objects[JIT_EXECUTE_WORD])
 161                         {
 162                                 if(i == length - 1)
 163                                 {
 164                                         if(stack_frame) emit(parent->special_objects[JIT_EPILOG]);
 165                                         tail_call = true;
 166                                         emit(parent->special_objects[JIT_EXECUTE_JUMP]);
 167                                 }
 168                                 else
 169                                         emit(parent->special_objects[JIT_EXECUTE_CALL]);
 170                         }
 171                         /* Everything else */
 172                         else
 173                         {
 174                                 if(i == length - 1)
 175                                 {
 176                                         if(stack_frame) emit(parent->special_objects[JIT_EPILOG]);
 177                                         tail_call = true;
 178                                         /* Inline cache misses are special-cased.
 179                                            The calling convention for tail
 180                                            calls stores the address of the next
 181                                            instruction in a register. However,
 182                                            PIC miss stubs themselves tail-call
 183                                            the inline cache miss primitive, and
 184                                            we don't want to clobber the saved
 185                                            address. */
 186                                         if(obj.value() == parent->special_objects[PIC_MISS_WORD]
 187                                            || obj.value() == parent->special_objects[PIC_MISS_TAIL_WORD])
 188                                         {
 189                                                 word_special(obj.value());
 190                                         }
 191                                         else
 192                                         {
 193                                                 word_jump(obj.value());
 194                                         }
 195                                 }
 196                                 else
 197                                         word_call(obj.value());
 198                         }
 199                         break;
 200                 case WRAPPER_TYPE:
 201                         push(obj.as<wrapper>()->object);
 202                         break;
 203                 case FIXNUM_TYPE:
 204                         /* Primitive calls */
 205                         if(primitive_call_p(i,length))
 206                         {
 207                                 parameter(tag_fixnum(0));
 208                                 parameter(obj.value());
 209                                 emit(parent->special_objects[JIT_PRIMITIVE]);
 210
 211                                 i++;
 212
 213                                 tail_call = true;
 214                         }
 215                         else
 216                                 push(obj.value());
 217                         break;
 218                 case QUOTATION_TYPE:
 219                         /* 'if' preceeded by two literal quotations (this is why if and ? are
 220                            mutually recursive in the library, but both still work) */
 221                         if(fast_if_p(i,length))
 222                         {
 223                                 if(stack_frame) emit(parent->special_objects[JIT_EPILOG]);
 224                                 tail_call = true;
 225
 226                                 emit_quot(array_nth(elements.untagged(),i));
 227                                 emit_quot(array_nth(elements.untagged(),i + 1));
 228                                 emit(parent->special_objects[JIT_IF]);
 229
 230                                 i += 2;
 231                         }
 232                         /* dip */
 233                         else if(fast_dip_p(i,length))
 234                         {
 235                                 emit_quot(obj.value());
 236                                 emit(parent->special_objects[JIT_DIP]);
 237                                 i++;
 238                         }
 239                         /* 2dip */
 240                         else if(fast_2dip_p(i,length))
 241                         {
 242                                 emit_quot(obj.value());
 243                                 emit(parent->special_objects[JIT_2DIP]);
 244                                 i++;
 245                         }
 246                         /* 3dip */
 247                         else if(fast_3dip_p(i,length))
 248                         {
 249                                 emit_quot(obj.value());
 250                                 emit(parent->special_objects[JIT_3DIP]);
 251                                 i++;
 252                         }
 253                         else
 254                                 push(obj.value());
 255                         break;
 256                 case ARRAY_TYPE:
 257                         /* Method dispatch */
 258                         if(mega_lookup_p(i,length))
 259                         {
 260                                 emit_mega_cache_lookup(
 261                                         array_nth(elements.untagged(),i),
 262                                         untag_fixnum(array_nth(elements.untagged(),i + 1)),
 263                                         array_nth(elements.untagged(),i + 2));
 264                                 i += 3;
 265                                 tail_call = true;
 266                         }
 267                         /* Non-optimizing compiler ignores declarations */
 268                         else if(declare_p(i,length))
 269                                 i++;
 270                         else
 271                                 push(obj.value());
 272                         break;
 273                 default:
 274                         push(obj.value());
 275                         break;
 276                 }
 277         }
 278
 279         if(!tail_call)
 280         {
 281                 set_position(length);
 282
 283                 if(stack_frame)
 284                         emit(parent->special_objects[JIT_EPILOG]);
 285                 emit(parent->special_objects[JIT_RETURN]);
 286         }
 287 }
 288
 289 void factor_vm::set_quot_xt(quotation *quot, code_block *code)
 290 {
 291         quot->code = code;
 292         quot->xt = code->xt();
 293 }
 294
 295 /* Allocates memory */
 296 code_block *factor_vm::jit_compile_quot(cell owner_, cell quot_, bool relocating)
 297 {
 298         data_root<object> owner(owner_,this);
 299         data_root<quotation> quot(quot_,this);
 300
 301         quotation_jit compiler(owner.value(),true,relocating,this);
 302         compiler.init_quotation(quot.value());
 303         compiler.iterate_quotation();
 304
 305         code_block *compiled = compiler.to_code_block();
 306
 307         if(relocating) initialize_code_block(compiled);
 308
 309         return compiled;
 310 }
 311
 312 void factor_vm::jit_compile_quot(cell quot_, bool relocating)
 313 {
 314         data_root<quotation> quot(quot_,this);
 315
 316         if(quot->code) return;
 317
 318         code_block *compiled = jit_compile_quot(quot.value(),quot.value(),relocating);
 319         set_quot_xt(quot.untagged(),compiled);
 320 }
 321
 322 void factor_vm::primitive_jit_compile()
 323 {
 324         jit_compile_quot(dpop(),true);
 325 }
 326
 327 /* push a new quotation on the stack */
 328 void factor_vm::primitive_array_to_quotation()
 329 {
 330         quotation *quot = allot<quotation>(sizeof(quotation));
 331         quot->array = dpeek();
 332         quot->cached_effect = false_object;
 333         quot->cache_counter = false_object;
 334         quot->xt = (void *)lazy_jit_compile;
 335         quot->code = NULL;
 336         drepl(tag<quotation>(quot));
 337 }
 338
 339 void factor_vm::primitive_quotation_xt()
 340 {
 341         quotation *quot = untag_check<quotation>(dpeek());
 342         drepl(allot_cell((cell)quot->xt));
 343 }
 344
 345 /* Compile a word definition with the non-optimizing compiler. Allocates memory */
 346 void factor_vm::jit_compile_word(cell word_, cell def_, bool relocating)
 347 {
 348         data_root<word> word(word_,this);
 349         data_root<quotation> def(def_,this);
 350
 351         code_block *compiled = jit_compile_quot(word.value(),def.value(),relocating);
 352         word->code = compiled;
 353
 354         if(to_boolean(word->pic_def)) jit_compile_quot(word->pic_def,relocating);
 355         if(to_boolean(word->pic_tail_def)) jit_compile_quot(word->pic_tail_def,relocating);
 356 }
 357
 358 void factor_vm::compile_all_words()
 359 {
 360         data_root<array> words(find_all_words(),this);
 361
 362         cell i;
 363         cell length = array_capacity(words.untagged());
 364         for(i = 0; i < length; i++)
 365         {
 366                 data_root<word> word(array_nth(words.untagged(),i),this);
 367
 368                 if(!word->code || !word->code->optimized_p())
 369                         jit_compile_word(word.value(),word->def,false);
 370
 371                 update_word_xt(word.untagged());
 372
 373         }
 374 }
 375
 376 /* Allocates memory */
 377 fixnum factor_vm::quot_code_offset_to_scan(cell quot_, cell offset)
 378 {
 379         data_root<quotation> quot(quot_,this);
 380         data_root<array> array(quot->array,this);
 381
 382         quotation_jit compiler(quot.value(),false,false,this);
 383         compiler.init_quotation(quot.value());
 384         compiler.compute_position(offset);
 385         compiler.iterate_quotation();
 386
 387         return compiler.get_position();
 388 }
 389
 390 cell factor_vm::lazy_jit_compile_impl(cell quot_, stack_frame *stack)
 391 {
 392         data_root<quotation> quot(quot_,this);
 393         ctx->callstack_top = stack;
 394         jit_compile_quot(quot.value(),true);
 395         return quot.value();
 396 }
 397
 398 VM_ASM_API cell lazy_jit_compile_impl(cell quot_, stack_frame *stack, factor_vm *parent)
 399 {
 400         return parent->lazy_jit_compile_impl(quot_,stack);
 401 }
 402
 403 void factor_vm::primitive_quot_compiled_p()
 404 {
 405         tagged<quotation> quot(dpop());
 406         quot.untag_check(this);
 407         dpush(tag_boolean(quot->code != NULL));
 408 }
 409
 410 }