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