vm/quotations.c

   1 #include "master.h"
   2
   3 /* Simple non-optimizing compiler.
   4
   5 This is one of the two compilers implementing Factor; the second one is written
   6 in Factor and performs advanced optimizations. See core/compiler/compiler.factor.
   7
   8 The non-optimizing compiler compiles a quotation at a time by concatenating
   9 machine code chunks; prolog, epilog, call word, jump to word, etc. These machine
  10 code chunks are generated from Factor code in core/cpu/.../bootstrap.factor.
  11
  12 Calls to words and constant quotations (referenced by conditionals and dips)
  13 are direct jumps to machine code blocks. Literals are also referenced directly
  14 without going through the literal table.
  15
  16 It actually does do a little bit of very simple optimization:
  17
  18 1) Tail call optimization.
  19
  20 2) If a quotation is determined to not call any other words (except for a few
  21 special words which are open-coded, see below), then no prolog/epilog is
  22 generated.
  23
  24 3) When in tail position and immediately preceded by literal arguments, the
  25 'if' and 'dispatch' conditionals are generated inline, instead of as a call to
  26 the 'if' word.
  27
  28 4) When preceded by a quotation, calls to 'dip', '2dip' and '3dip' are
  29 open-coded as retain stack manipulation surrounding a subroutine call.
  30
  31 5) When preceded by an array, calls to the 'declare' word are optimized out
  32 entirely. This word is only used by the optimizing compiler, and with the
  33 non-optimizing compiler it would otherwise just decrease performance to have to
  34 push the array and immediately drop it after.
  35
  36 6) Sub-primitives are primitive words which are implemented in assembly and not
  37 in the VM. They are open-coded and no subroutine call is generated. This
  38 includes stack shufflers, some fixnum arithmetic words, and words such as tag,
  39 slot and eq?. A primitive call is relatively expensive (two subroutine calls)
  40 so this results in a big speedup for relatively little effort. */
  41
  42 bool jit_primitive_call_p(F_ARRAY *array, CELL i)
  43 {
  44         return (i + 2) == array_capacity(array)
  45                 && type_of(array_nth(array,i)) == FIXNUM_TYPE
  46                 && array_nth(array,i + 1) == userenv[JIT_PRIMITIVE_WORD];
  47 }
  48
  49 bool jit_fast_if_p(F_ARRAY *array, CELL i)
  50 {
  51         return (i + 3) == array_capacity(array)
  52                 && type_of(array_nth(array,i)) == QUOTATION_TYPE
  53                 && type_of(array_nth(array,i + 1)) == QUOTATION_TYPE
  54                 && array_nth(array,i + 2) == userenv[JIT_IF_WORD];
  55 }
  56
  57 bool jit_fast_dispatch_p(F_ARRAY *array, CELL i)
  58 {
  59         return (i + 2) == array_capacity(array)
  60                 && type_of(array_nth(array,i)) == ARRAY_TYPE
  61                 && array_nth(array,i + 1) == userenv[JIT_DISPATCH_WORD];
  62 }
  63
  64 bool jit_fast_dip_p(F_ARRAY *array, CELL i)
  65 {
  66         return (i + 2) <= array_capacity(array)
  67                 && type_of(array_nth(array,i)) == QUOTATION_TYPE
  68                 && array_nth(array,i + 1) == userenv[JIT_DIP_WORD];
  69 }
  70
  71 bool jit_fast_2dip_p(F_ARRAY *array, CELL i)
  72 {
  73         return (i + 2) <= array_capacity(array)
  74                 && type_of(array_nth(array,i)) == QUOTATION_TYPE
  75                 && array_nth(array,i + 1) == userenv[JIT_2DIP_WORD];
  76 }
  77
  78 bool jit_fast_3dip_p(F_ARRAY *array, CELL i)
  79 {
  80         return (i + 2) <= array_capacity(array)
  81                 && type_of(array_nth(array,i)) == QUOTATION_TYPE
  82                 && array_nth(array,i + 1) == userenv[JIT_3DIP_WORD];
  83 }
  84
  85 bool jit_ignore_declare_p(F_ARRAY *array, CELL i)
  86 {
  87         return (i + 1) < array_capacity(array)
  88                 && type_of(array_nth(array,i)) == ARRAY_TYPE
  89                 && array_nth(array,i + 1) == userenv[JIT_DECLARE_WORD];
  90 }
  91
  92 F_ARRAY *code_to_emit(CELL code)
  93 {
  94         return untag_object(array_nth(untag_object(code),0));
  95 }
  96
  97 F_REL rel_to_emit(CELL code, CELL code_format, CELL code_length,
  98         CELL rel_argument, bool *rel_p)
  99 {
 100         F_ARRAY *quadruple = untag_object(code);
 101         CELL rel_class = array_nth(quadruple,1);
 102         CELL rel_type = array_nth(quadruple,2);
 103         CELL offset = array_nth(quadruple,3);
 104
 105         F_REL rel;
 106
 107         if(rel_class == F)
 108         {
 109                 *rel_p = false;
 110                 rel.type = 0;
 111                 rel.offset = 0;
 112         }
 113         else
 114         {
 115                 *rel_p = true;
 116                 rel.type = to_fixnum(rel_type)
 117                         | (to_fixnum(rel_class) << 8)
 118                         | (rel_argument << 16);
 119                 rel.offset = (code_length + to_fixnum(offset)) * code_format;
 120         }
 121
 122         return rel;
 123 }
 124
 125 #define EMIT(name,rel_argument) { \
 126                 bool rel_p; \
 127                 F_REL rel = rel_to_emit(name,code_format,code_count,rel_argument,&rel_p); \
 128                 if(rel_p) GROWABLE_BYTE_ARRAY_APPEND(relocation,&rel,sizeof(F_REL)); \
 129                 GROWABLE_ARRAY_APPEND(code,code_to_emit(name)); \
 130         }
 131
 132 bool jit_stack_frame_p(F_ARRAY *array)
 133 {
 134         F_FIXNUM length = array_capacity(array);
 135         F_FIXNUM i;
 136
 137         for(i = 0; i < length - 1; i++)
 138         {
 139                 CELL obj = array_nth(array,i);
 140                 if(type_of(obj) == WORD_TYPE)
 141                 {
 142                         F_WORD *word = untag_object(obj);
 143                         if(word->subprimitive == F && obj != userenv[JIT_DECLARE_WORD])
 144                                 return true;
 145                 }
 146                 else if(type_of(obj) == QUOTATION_TYPE)
 147                 {
 148                         if(jit_fast_dip_p(array,i)
 149                                 || jit_fast_2dip_p(array,i)
 150                                 || jit_fast_3dip_p(array,i))
 151                                 return true;
 152                 }
 153         }
 154
 155         return false;
 156 }
 157
 158 void set_quot_xt(F_QUOTATION *quot, F_CODE_BLOCK *code)
 159 {
 160         if(code->type != QUOTATION_TYPE)
 161                 critical_error("bad param to set_quot_xt",(CELL)code);
 162
 163         quot->code = code;
 164         quot->xt = (XT)(code + 1);
 165         quot->compiledp = T;
 166 }
 167
 168 /* Might GC */
 169 void jit_compile(CELL quot, bool relocate)
 170 {
 171         if(untag_quotation(quot)->compiledp != F)
 172                 return;
 173
 174         CELL code_format = compiled_code_format();
 175
 176         REGISTER_ROOT(quot);
 177
 178         CELL array = untag_quotation(quot)->array;
 179         REGISTER_ROOT(array);
 180
 181         GROWABLE_ARRAY(code);
 182         REGISTER_ROOT(code);
 183
 184         GROWABLE_BYTE_ARRAY(relocation);
 185         REGISTER_ROOT(relocation);
 186
 187         GROWABLE_ARRAY(literals);
 188         REGISTER_ROOT(literals);
 189
 190         GROWABLE_ARRAY_ADD(literals,stack_traces_p() ? quot : F);
 191
 192         bool stack_frame = jit_stack_frame_p(untag_object(array));
 193
 194         if(stack_frame)
 195                 EMIT(userenv[JIT_PROLOG],0);
 196
 197         CELL i;
 198         CELL length = array_capacity(untag_object(array));
 199         bool tail_call = false;
 200
 201         for(i = 0; i < length; i++)
 202         {
 203                 CELL obj = array_nth(untag_object(array),i);
 204                 F_WORD *word;
 205                 F_WRAPPER *wrapper;
 206
 207                 switch(type_of(obj))
 208                 {
 209                 case WORD_TYPE:
 210                         word = untag_object(obj);
 211
 212                         /* Intrinsics */
 213                         if(word->subprimitive != F)
 214                         {
 215                                 if(array_nth(untag_object(word->subprimitive),1) != F)
 216                                 {
 217                                         GROWABLE_ARRAY_ADD(literals,T);
 218                                 }
 219
 220                                 EMIT(word->subprimitive,literals_count - 1);
 221                         }
 222                         else
 223                         {
 224                                 GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
 225
 226                                 if(i == length - 1)
 227                                 {
 228                                         if(stack_frame)
 229                                                 EMIT(userenv[JIT_EPILOG],0);
 230
 231                                         EMIT(userenv[JIT_WORD_JUMP],literals_count - 1);
 232
 233                                         tail_call = true;
 234                                 }
 235                                 else
 236                                         EMIT(userenv[JIT_WORD_CALL],literals_count - 1);
 237                         }
 238                         break;
 239                 case WRAPPER_TYPE:
 240                         wrapper = untag_object(obj);
 241                         GROWABLE_ARRAY_ADD(literals,wrapper->object);
 242                         EMIT(userenv[JIT_PUSH_IMMEDIATE],literals_count - 1);
 243                         break;
 244                 case FIXNUM_TYPE:
 245                         if(jit_primitive_call_p(untag_object(array),i))
 246                         {
 247                                 EMIT(userenv[JIT_SAVE_STACK],0);
 248                                 EMIT(userenv[JIT_PRIMITIVE],to_fixnum(obj));
 249
 250                                 i++;
 251
 252                                 tail_call = true;
 253                                 break;
 254                         }
 255                 case QUOTATION_TYPE:
 256                         if(jit_fast_if_p(untag_object(array),i))
 257                         {
 258                                 if(stack_frame)
 259                                         EMIT(userenv[JIT_EPILOG],0);
 260
 261                                 jit_compile(array_nth(untag_object(array),i),relocate);
 262                                 jit_compile(array_nth(untag_object(array),i + 1),relocate);
 263
 264                                 GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
 265                                 EMIT(userenv[JIT_IF_1],literals_count - 1);
 266                                 GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i + 1));
 267                                 EMIT(userenv[JIT_IF_2],literals_count - 1);
 268
 269                                 i += 2;
 270
 271                                 tail_call = true;
 272                                 break;
 273                         }
 274                         else if(jit_fast_dip_p(untag_object(array),i))
 275                         {
 276                                 jit_compile(obj,relocate);
 277
 278                                 GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
 279                                 EMIT(userenv[JIT_DIP],literals_count - 1);
 280
 281                                 i++;
 282                                 break;
 283                         }
 284                         else if(jit_fast_2dip_p(untag_object(array),i))
 285                         {
 286                                 jit_compile(obj,relocate);
 287
 288                                 GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
 289                                 EMIT(userenv[JIT_2DIP],literals_count - 1);
 290
 291                                 i++;
 292                                 break;
 293                         }
 294                         else if(jit_fast_3dip_p(untag_object(array),i))
 295                         {
 296                                 jit_compile(obj,relocate);
 297
 298                                 GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
 299                                 EMIT(userenv[JIT_3DIP],literals_count - 1);
 300
 301                                 i++;
 302                                 break;
 303                         }
 304                 case ARRAY_TYPE:
 305                         if(jit_fast_dispatch_p(untag_object(array),i))
 306                         {
 307                                 if(stack_frame)
 308                                         EMIT(userenv[JIT_EPILOG],0);
 309
 310                                 GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
 311                                 EMIT(userenv[JIT_DISPATCH],literals_count - 1);
 312
 313                                 i++;
 314
 315                                 tail_call = true;
 316                                 break;
 317                         }
 318                         else if(jit_ignore_declare_p(untag_object(array),i))
 319                         {
 320                                 i++;
 321                                 break;
 322                         }
 323                 default:
 324                         GROWABLE_ARRAY_ADD(literals,obj);
 325                         EMIT(userenv[JIT_PUSH_IMMEDIATE],literals_count - 1);
 326                         break;
 327                 }
 328         }
 329
 330         if(!tail_call)
 331         {
 332                 if(stack_frame)
 333                         EMIT(userenv[JIT_EPILOG],0);
 334
 335                 EMIT(userenv[JIT_RETURN],0);
 336         }
 337
 338         GROWABLE_ARRAY_TRIM(code);
 339         GROWABLE_ARRAY_TRIM(literals);
 340         GROWABLE_BYTE_ARRAY_TRIM(relocation);
 341
 342         F_CODE_BLOCK *compiled = add_compiled_block(
 343                 QUOTATION_TYPE,
 344                 untag_object(code),
 345                 NULL,
 346                 relocation,
 347                 literals);
 348
 349         set_quot_xt(untag_object(quot),compiled);
 350
 351         if(relocate)
 352                 relocate_code_block(compiled);
 353
 354         UNREGISTER_ROOT(literals);
 355         UNREGISTER_ROOT(relocation);
 356         UNREGISTER_ROOT(code);
 357         UNREGISTER_ROOT(array);
 358         UNREGISTER_ROOT(quot);
 359 }
 360
 361 /* Crappy code duplication. If C had closures (not just function pointers)
 362 it would be easy to get rid of, but I can't think of a good way to deal
 363 with it right now that doesn't involve lots of boilerplate that would be
 364 worse than the duplication itself (eg, putting all state in some global
 365 struct.) */
 366 #define COUNT(name,scan) \
 367         { \
 368                 CELL size = array_capacity(code_to_emit(name)) * code_format; \
 369                 if(offset == 0) return scan - 1; \
 370                 if(offset < size) return scan + 1; \
 371                 offset -= size; \
 372         }
 373
 374 F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset)
 375 {
 376         CELL code_format = compiled_code_format();
 377
 378         CELL array = untag_quotation(quot)->array;
 379
 380         bool stack_frame = jit_stack_frame_p(untag_object(array));
 381
 382         if(stack_frame)
 383                 COUNT(userenv[JIT_PROLOG],0)
 384
 385         CELL i;
 386         CELL length = array_capacity(untag_object(array));
 387         bool tail_call = false;
 388
 389         for(i = 0; i < length; i++)
 390         {
 391                 CELL obj = array_nth(untag_object(array),i);
 392                 F_WORD *word;
 393
 394                 switch(type_of(obj))
 395                 {
 396                 case WORD_TYPE:
 397                         /* Intrinsics */
 398                         word = untag_object(obj);
 399                         if(word->subprimitive != F)
 400                                 COUNT(word->subprimitive,i)
 401                         else if(i == length - 1)
 402                         {
 403                                 if(stack_frame)
 404                                         COUNT(userenv[JIT_EPILOG],i);
 405
 406                                 COUNT(userenv[JIT_WORD_JUMP],i)
 407
 408                                 tail_call = true;
 409                         }
 410                         else
 411                                 COUNT(userenv[JIT_WORD_CALL],i)
 412                         break;
 413                 case WRAPPER_TYPE:
 414                         COUNT(userenv[JIT_PUSH_IMMEDIATE],i)
 415                         break;
 416                 case FIXNUM_TYPE:
 417                         if(jit_primitive_call_p(untag_object(array),i))
 418                         {
 419                                 COUNT(userenv[JIT_SAVE_STACK],i);
 420                                 COUNT(userenv[JIT_PRIMITIVE],i);
 421
 422                                 i++;
 423
 424                                 tail_call = true;
 425                                 break;
 426                         }
 427                 case QUOTATION_TYPE:
 428                         if(jit_fast_if_p(untag_object(array),i))
 429                         {
 430                                 if(stack_frame)
 431                                         COUNT(userenv[JIT_EPILOG],i)
 432
 433                                 COUNT(userenv[JIT_IF_1],i)
 434                                 COUNT(userenv[JIT_IF_2],i)
 435                                 i += 2;
 436
 437                                 tail_call = true;
 438                                 break;
 439                         }
 440                         else if(jit_fast_dip_p(untag_object(array),i))
 441                         {
 442                                 COUNT(userenv[JIT_DIP],i)
 443                                 i++;
 444                                 break;
 445                         }
 446                         else if(jit_fast_2dip_p(untag_object(array),i))
 447                         {
 448                                 COUNT(userenv[JIT_2DIP],i)
 449                                 i++;
 450                                 break;
 451                         }
 452                         else if(jit_fast_3dip_p(untag_object(array),i))
 453                         {
 454                                 COUNT(userenv[JIT_3DIP],i)
 455                                 i++;
 456                                 break;
 457                         }
 458                 case ARRAY_TYPE:
 459                         if(jit_fast_dispatch_p(untag_object(array),i))
 460                         {
 461                                 if(stack_frame)
 462                                         COUNT(userenv[JIT_EPILOG],i)
 463
 464                                 i++;
 465
 466                                 COUNT(userenv[JIT_DISPATCH],i)
 467
 468                                 tail_call = true;
 469                                 break;
 470                         }
 471                         if(jit_ignore_declare_p(untag_object(array),i))
 472                         {
 473                                 if(offset == 0) return i;
 474
 475                                 i++;
 476
 477                                 break;
 478                         }
 479                 default:
 480                         COUNT(userenv[JIT_PUSH_IMMEDIATE],i)
 481                         break;
 482                 }
 483         }
 484
 485         if(!tail_call)
 486         {
 487                 if(stack_frame)
 488                         COUNT(userenv[JIT_EPILOG],length)
 489
 490                 COUNT(userenv[JIT_RETURN],length)
 491         }
 492
 493         return -1;
 494 }
 495
 496 F_FASTCALL CELL lazy_jit_compile_impl(CELL quot, F_STACK_FRAME *stack)
 497 {
 498         stack_chain->callstack_top = stack;
 499         REGISTER_ROOT(quot);
 500         jit_compile(quot,true);
 501         UNREGISTER_ROOT(quot);
 502         return quot;
 503 }
 504
 505 void primitive_jit_compile(void)
 506 {
 507         jit_compile(dpop(),true);
 508 }
 509
 510 /* push a new quotation on the stack */
 511 void primitive_array_to_quotation(void)
 512 {
 513         F_QUOTATION *quot = allot_object(QUOTATION_TYPE,sizeof(F_QUOTATION));
 514         quot->array = dpeek();
 515         quot->xt = lazy_jit_compile;
 516         quot->compiledp = F;
 517         drepl(tag_object(quot));
 518 }
 519
 520 void primitive_quotation_xt(void)
 521 {
 522         F_QUOTATION *quot = untag_quotation(dpeek());
 523         drepl(allot_cell((CELL)quot->xt));
 524 }
 525
 526 void compile_all_words(void)
 527 {
 528         CELL words = find_all_words();
 529
 530         REGISTER_ROOT(words);
 531
 532         CELL i;
 533         CELL length = array_capacity(untag_object(words));
 534         for(i = 0; i < length; i++)
 535         {
 536                 F_WORD *word = untag_word(array_nth(untag_array(words),i));
 537                 REGISTER_UNTAGGED(word);
 538                 if(word->optimizedp == F)
 539                         default_word_code(word,false);
 540                 UNREGISTER_UNTAGGED(word);
 541                 update_word_xt(word);
 542         }
 543
 544         UNREGISTER_ROOT(words);
 545
 546         iterate_code_heap(relocate_code_block);
 547 }