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 bool quotation_jit::primitive_call_p(cell i, cell length)
  40 {
  41         return (i + 2) == length && array_nth(elements.untagged(),i + 1) == parent->special_objects[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->special_objects[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->special_objects[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->special_objects[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->special_objects[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->special_objects[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->special_objects[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->to_boolean(untag<word>(obj)->subprimitive))
  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         data_root<quotation> quot(quot_,parent);
 114
 115         array *elements = 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->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->special_objects[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                 data_root<object> obj(array_nth(elements.untagged(),i),parent);
 147
 148                 switch(obj.type())
 149                 {
 150                 case WORD_TYPE:
 151                         /* Intrinsics */
 152                         if(parent->to_boolean(obj.as<word>()->subprimitive))
 153                                 emit_subprimitive(obj.value());
 154                         /* The (execute) primitive is special-cased */
 155                         else if(obj.value() == parent->special_objects[JIT_EXECUTE_WORD])
 156                         {
 157                                 if(i == length - 1)
 158                                 {
 159                                         if(stack_frame) emit(parent->special_objects[JIT_EPILOG]);
 160                                         tail_call = true;
 161                                         emit(parent->special_objects[JIT_EXECUTE_JUMP]);
 162                                 }
 163                                 else
 164                                         emit(parent->special_objects[JIT_EXECUTE_CALL]);
 165                         }
 166                         /* Everything else */
 167                         else
 168                         {
 169                                 if(i == length - 1)
 170                                 {
 171                                         if(stack_frame) emit(parent->special_objects[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->special_objects[PIC_MISS_WORD]
 182                                            || obj.value() == parent->special_objects[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                                 literal(tag_fixnum(0));
 203                                 literal(obj.value());
 204                                 emit(parent->special_objects[JIT_PRIMITIVE]);
 205
 206                                 i++;
 207
 208                                 tail_call = true;
 209                         }
 210                         else
 211                                 push(obj.value());
 212                         break;
 213                 case QUOTATION_TYPE:
 214                         /* 'if' preceeded by two literal quotations (this is why if and ? are
 215                            mutually recursive in the library, but both still work) */
 216                         if(fast_if_p(i,length))
 217                         {
 218                                 if(stack_frame) emit(parent->special_objects[JIT_EPILOG]);
 219                                 tail_call = true;
 220
 221                                 emit_quot(array_nth(elements.untagged(),i));
 222                                 emit_quot(array_nth(elements.untagged(),i + 1));
 223                                 emit(parent->special_objects[JIT_IF]);
 224
 225                                 i += 2;
 226                         }
 227                         /* dip */
 228                         else if(fast_dip_p(i,length))
 229                         {
 230                                 emit_quot(obj.value());
 231                                 emit(parent->special_objects[JIT_DIP]);
 232                                 i++;
 233                         }
 234                         /* 2dip */
 235                         else if(fast_2dip_p(i,length))
 236                         {
 237                                 emit_quot(obj.value());
 238                                 emit(parent->special_objects[JIT_2DIP]);
 239                                 i++;
 240                         }
 241                         /* 3dip */
 242                         else if(fast_3dip_p(i,length))
 243                         {
 244                                 emit_quot(obj.value());
 245                                 emit(parent->special_objects[JIT_3DIP]);
 246                                 i++;
 247                         }
 248                         else
 249                                 push(obj.value());
 250                         break;
 251                 case ARRAY_TYPE:
 252                         /* Method dispatch */
 253                         if(mega_lookup_p(i,length))
 254                         {
 255                                 emit_mega_cache_lookup(
 256                                         array_nth(elements.untagged(),i),
 257                                         untag_fixnum(array_nth(elements.untagged(),i + 1)),
 258                                         array_nth(elements.untagged(),i + 2));
 259                                 i += 3;
 260                                 tail_call = true;
 261                         }
 262                         /* Non-optimizing compiler ignores declarations */
 263                         else if(declare_p(i,length))
 264                                 i++;
 265                         else
 266                                 push(obj.value());
 267                         break;
 268                 default:
 269                         push(obj.value());
 270                         break;
 271                 }
 272         }
 273
 274         if(!tail_call)
 275         {
 276                 set_position(length);
 277
 278                 if(stack_frame)
 279                         emit(parent->special_objects[JIT_EPILOG]);
 280                 emit(parent->special_objects[JIT_RETURN]);
 281         }
 282 }
 283
 284 void factor_vm::set_quot_xt(quotation *quot, code_block *code)
 285 {
 286         quot->code = code;
 287         quot->xt = code->xt();
 288 }
 289
 290 /* Allocates memory */
 291 void factor_vm::jit_compile(cell quot_, bool relocating)
 292 {
 293         data_root<quotation> quot(quot_,this);
 294         if(quot->code) return;
 295
 296         quotation_jit compiler(quot.value(),true,relocating,this);
 297         compiler.iterate_quotation();
 298
 299         code_block *compiled = compiler.to_code_block();
 300         set_quot_xt(quot.untagged(),compiled);
 301
 302         if(relocating) relocate_code_block(compiled);
 303 }
 304
 305 void factor_vm::primitive_jit_compile()
 306 {
 307         jit_compile(dpop(),true);
 308 }
 309
 310 /* push a new quotation on the stack */
 311 void factor_vm::primitive_array_to_quotation()
 312 {
 313         quotation *quot = allot<quotation>(sizeof(quotation));
 314         quot->array = dpeek();
 315         quot->cached_effect = false_object;
 316         quot->cache_counter = false_object;
 317         quot->xt = (void *)lazy_jit_compile;
 318         quot->code = NULL;
 319         drepl(tag<quotation>(quot));
 320 }
 321
 322 void factor_vm::primitive_quotation_xt()
 323 {
 324         quotation *quot = untag_check<quotation>(dpeek());
 325         drepl(allot_cell((cell)quot->xt));
 326 }
 327
 328 void factor_vm::compile_all_words()
 329 {
 330         data_root<array> words(find_all_words(),this);
 331
 332         cell i;
 333         cell length = array_capacity(words.untagged());
 334         for(i = 0; i < length; i++)
 335         {
 336                 data_root<word> word(array_nth(words.untagged(),i),this);
 337
 338                 if(!word->code || !word->code->optimized_p())
 339                         jit_compile_word(word.value(),word->def,false);
 340
 341                 update_word_xt(word.untagged());
 342
 343         }
 344 }
 345
 346 /* Allocates memory */
 347 fixnum factor_vm::quot_code_offset_to_scan(cell quot_, cell offset)
 348 {
 349         data_root<quotation> quot(quot_,this);
 350         data_root<array> array(quot->array,this);
 351
 352         quotation_jit compiler(quot.value(),false,false,this);
 353         compiler.compute_position(offset);
 354         compiler.iterate_quotation();
 355
 356         return compiler.get_position();
 357 }
 358
 359 cell factor_vm::lazy_jit_compile_impl(cell quot_, stack_frame *stack)
 360 {
 361         data_root<quotation> quot(quot_,this);
 362         ctx->callstack_top = stack;
 363         jit_compile(quot.value(),true);
 364         return quot.value();
 365 }
 366
 367 VM_ASM_API cell lazy_jit_compile_impl(cell quot_, stack_frame *stack, factor_vm *parent)
 368 {
 369         return parent->lazy_jit_compile_impl(quot_,stack);
 370 }
 371
 372 void factor_vm::primitive_quot_compiled_p()
 373 {
 374         tagged<quotation> quot(dpop());
 375         quot.untag_check(this);
 376         dpush(tag_boolean(quot->code != NULL));
 377 }
 378
 379 }