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_ignore_declare_p(F_ARRAY *array, CELL i)
  58 {
  59         return (i + 1) < array_capacity(array)
  60                 && type_of(array_nth(array,i)) == ARRAY_TYPE
  61                 && array_nth(array,i + 1) == userenv[JIT_DECLARE_WORD];
  62 }
  63
  64 F_ARRAY *code_to_emit(CELL code)
  65 {
  66         return untag_object(array_nth(untag_object(code),0));
  67 }
  68
  69 F_REL rel_to_emit(CELL code, CELL code_format, CELL code_length,
  70         CELL rel_argument, bool *rel_p)
  71 {
  72         F_ARRAY *quadruple = untag_object(code);
  73         CELL rel_class = array_nth(quadruple,1);
  74         CELL rel_type = array_nth(quadruple,2);
  75         CELL offset = array_nth(quadruple,3);
  76
  77         F_REL rel;
  78
  79         if(rel_class == F)
  80         {
  81                 *rel_p = false;
  82                 rel.type = 0;
  83                 rel.offset = 0;
  84         }
  85         else
  86         {
  87                 *rel_p = true;
  88                 rel.type = to_fixnum(rel_type)
  89                         | (to_fixnum(rel_class) << 8)
  90                         | (rel_argument << 16);
  91                 rel.offset = (code_length + to_fixnum(offset)) * code_format;
  92         }
  93
  94         return rel;
  95 }
  96
  97 #define EMIT(name,rel_argument) { \
  98                 bool rel_p; \
  99                 F_REL rel = rel_to_emit(name,code_format,code_count,rel_argument,&rel_p); \
 100                 if(rel_p) GROWABLE_BYTE_ARRAY_APPEND(relocation,&rel,sizeof(F_REL)); \
 101                 GROWABLE_ARRAY_APPEND(code,code_to_emit(name)); \
 102         }
 103
 104 bool jit_stack_frame_p(F_ARRAY *array)
 105 {
 106         F_FIXNUM length = array_capacity(array);
 107         F_FIXNUM i;
 108
 109         for(i = 0; i < length - 1; i++)
 110         {
 111                 CELL obj = array_nth(array,i);
 112                 if(type_of(obj) == WORD_TYPE)
 113                 {
 114                         F_WORD *word = untag_object(obj);
 115                         if(word->subprimitive == F && obj != userenv[JIT_DECLARE_WORD])
 116                                 return true;
 117                 }
 118         }
 119
 120         return false;
 121 }
 122
 123 void set_quot_xt(F_QUOTATION *quot, F_COMPILED *code)
 124 {
 125         if(code->type != QUOTATION_TYPE)
 126                 critical_error("bad param to set_quot_xt",(CELL)code);
 127
 128         quot->code = code;
 129         quot->xt = (XT)(code + 1);
 130         quot->compiledp = T;
 131 }
 132
 133 /* Might GC */
 134 void jit_compile(CELL quot, bool relocate)
 135 {
 136         if(untag_quotation(quot)->compiledp != F)
 137                 return;
 138
 139         CELL code_format = compiled_code_format();
 140
 141         REGISTER_ROOT(quot);
 142
 143         CELL array = untag_quotation(quot)->array;
 144         REGISTER_ROOT(array);
 145
 146         GROWABLE_ARRAY(code);
 147         REGISTER_ROOT(code);
 148
 149         GROWABLE_BYTE_ARRAY(relocation);
 150         REGISTER_ROOT(relocation);
 151
 152         GROWABLE_ARRAY(literals);
 153         REGISTER_ROOT(literals);
 154
 155         GROWABLE_ARRAY_ADD(literals,stack_traces_p() ? quot : F);
 156
 157         bool stack_frame = jit_stack_frame_p(untag_object(array));
 158
 159         if(stack_frame)
 160                 EMIT(userenv[JIT_PROLOG],0);
 161
 162         CELL i;
 163         CELL length = array_capacity(untag_object(array));
 164         bool tail_call = false;
 165
 166         for(i = 0; i < length; i++)
 167         {
 168                 CELL obj = array_nth(untag_object(array),i);
 169                 F_WORD *word;
 170                 F_WRAPPER *wrapper;
 171
 172                 switch(type_of(obj))
 173                 {
 174                 case WORD_TYPE:
 175                         word = untag_object(obj);
 176
 177                         /* Intrinsics */
 178                         if(word->subprimitive != F)
 179                         {
 180                                 if(array_nth(untag_object(word->subprimitive),1) != F)
 181                                 {
 182                                         GROWABLE_ARRAY_ADD(literals,T);
 183                                 }
 184
 185                                 EMIT(word->subprimitive,literals_count - 1);
 186                         }
 187                         else
 188                         {
 189                                 GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
 190
 191                                 if(i == length - 1)
 192                                 {
 193                                         if(stack_frame)
 194                                                 EMIT(userenv[JIT_EPILOG],0);
 195
 196                                         EMIT(userenv[JIT_WORD_JUMP],literals_count - 1);
 197
 198                                         tail_call = true;
 199                                 }
 200                                 else
 201                                         EMIT(userenv[JIT_WORD_CALL],literals_count - 1);
 202                         }
 203                         break;
 204                 case WRAPPER_TYPE:
 205                         wrapper = untag_object(obj);
 206                         GROWABLE_ARRAY_ADD(literals,wrapper->object);
 207                         EMIT(userenv[JIT_PUSH_LITERAL],literals_count - 1);
 208                         break;
 209                 case FIXNUM_TYPE:
 210                         if(jit_primitive_call_p(untag_object(array),i))
 211                         {
 212                                 EMIT(userenv[JIT_SAVE_STACK],0);
 213                                 EMIT(userenv[JIT_PRIMITIVE],to_fixnum(obj));
 214
 215                                 i++;
 216
 217                                 tail_call = true;
 218                                 break;
 219                         }
 220                 case QUOTATION_TYPE:
 221                         if(jit_fast_if_p(untag_object(array),i))
 222                         {
 223                                 if(stack_frame)
 224                                         EMIT(userenv[JIT_EPILOG],0);
 225
 226                                 GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
 227                                 GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i + 1));
 228                                 EMIT(userenv[JIT_IF_JUMP],literals_count - 2);
 229
 230                                 i += 2;
 231
 232                                 tail_call = true;
 233                                 break;
 234                         }
 235                 case ARRAY_TYPE:
 236                         if(jit_fast_dispatch_p(untag_object(array),i))
 237                         {
 238                                 if(stack_frame)
 239                                         EMIT(userenv[JIT_EPILOG],0);
 240
 241                                 GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
 242                                 EMIT(userenv[JIT_DISPATCH],literals_count - 1);
 243
 244                                 i++;
 245
 246                                 tail_call = true;
 247                                 break;
 248                         }
 249                         else if(jit_ignore_declare_p(untag_object(array),i))
 250                         {
 251                                 i++;
 252                                 break;
 253                         }
 254                 default:
 255                         GROWABLE_ARRAY_ADD(literals,obj);
 256                         EMIT(userenv[immediate_p(obj) ? JIT_PUSH_IMMEDIATE : JIT_PUSH_LITERAL],literals_count - 1);
 257                         break;
 258                 }
 259         }
 260
 261         if(!tail_call)
 262         {
 263                 if(stack_frame)
 264                         EMIT(userenv[JIT_EPILOG],0);
 265
 266                 EMIT(userenv[JIT_RETURN],0);
 267         }
 268
 269         GROWABLE_ARRAY_TRIM(code);
 270         GROWABLE_ARRAY_TRIM(literals);
 271         GROWABLE_BYTE_ARRAY_TRIM(relocation);
 272
 273         F_COMPILED *compiled = add_compiled_block(
 274                 QUOTATION_TYPE,
 275                 untag_object(code),
 276                 NULL,
 277                 relocation,
 278                 untag_object(literals));
 279
 280         set_quot_xt(untag_object(quot),compiled);
 281
 282         if(relocate)
 283                 iterate_code_heap_step(compiled,relocate_code_block);
 284
 285         UNREGISTER_ROOT(literals);
 286         UNREGISTER_ROOT(relocation);
 287         UNREGISTER_ROOT(code);
 288         UNREGISTER_ROOT(array);
 289         UNREGISTER_ROOT(quot);
 290 }
 291
 292 /* Crappy code duplication. If C had closures (not just function pointers)
 293 it would be easy to get rid of, but I can't think of a good way to deal
 294 with it right now that doesn't involve lots of boilerplate that would be
 295 worse than the duplication itself (eg, putting all state in some global
 296 struct.) */
 297 #define COUNT(name,scan) \
 298         { \
 299                 if(offset == 0) return scan - 1; \
 300                 offset -= array_capacity(code_to_emit(name)) * code_format; \
 301         }
 302
 303 F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset)
 304 {
 305         CELL code_format = compiled_code_format();
 306
 307         CELL array = untag_quotation(quot)->array;
 308
 309         bool stack_frame = jit_stack_frame_p(untag_object(array));
 310
 311         if(stack_frame)
 312                 COUNT(userenv[JIT_PROLOG],0)
 313
 314         CELL i;
 315         CELL length = array_capacity(untag_object(array));
 316         bool tail_call = false;
 317
 318         for(i = 0; i < length; i++)
 319         {
 320                 CELL obj = array_nth(untag_object(array),i);
 321                 F_WORD *word;
 322
 323                 switch(type_of(obj))
 324                 {
 325                 case WORD_TYPE:
 326                         /* Intrinsics */
 327                         word = untag_object(obj);
 328                         if(word->subprimitive != F)
 329                                 COUNT(word->subprimitive,i)
 330                         else if(i == length - 1)
 331                         {
 332                                 if(stack_frame)
 333                                         COUNT(userenv[JIT_EPILOG],i);
 334
 335                                 COUNT(userenv[JIT_WORD_JUMP],i)
 336
 337                                 tail_call = true;
 338                         }
 339                         else
 340                                 COUNT(userenv[JIT_WORD_CALL],i)
 341                         break;
 342                 case WRAPPER_TYPE:
 343                         COUNT(userenv[JIT_PUSH_LITERAL],i)
 344                         break;
 345                 case FIXNUM_TYPE:
 346                         if(jit_primitive_call_p(untag_object(array),i))
 347                         {
 348                                 COUNT(userenv[JIT_SAVE_STACK],i);
 349                                 COUNT(userenv[JIT_PRIMITIVE],i);
 350
 351                                 i++;
 352
 353                                 tail_call = true;
 354                                 break;
 355                         }
 356                 case QUOTATION_TYPE:
 357                         if(jit_fast_if_p(untag_object(array),i))
 358                         {
 359                                 if(stack_frame)
 360                                         COUNT(userenv[JIT_EPILOG],i)
 361
 362                                 i += 2;
 363
 364                                 COUNT(userenv[JIT_IF_JUMP],i)
 365
 366                                 tail_call = true;
 367                                 break;
 368                         }
 369                 case ARRAY_TYPE:
 370                         if(jit_fast_dispatch_p(untag_object(array),i))
 371                         {
 372                                 if(stack_frame)
 373                                         COUNT(userenv[JIT_EPILOG],i)
 374
 375                                 i++;
 376
 377                                 COUNT(userenv[JIT_DISPATCH],i)
 378
 379                                 tail_call = true;
 380                                 break;
 381                         }
 382                         if(jit_ignore_declare_p(untag_object(array),i))
 383                         {
 384                                 if(offset == 0) return i;
 385
 386                                 i++;
 387
 388                                 break;
 389                         }
 390                 default:
 391                         COUNT(userenv[immediate_p(obj) ? JIT_PUSH_IMMEDIATE : JIT_PUSH_LITERAL],i)
 392                         break;
 393                 }
 394         }
 395
 396         if(!tail_call)
 397         {
 398                 if(stack_frame)
 399                         COUNT(userenv[JIT_EPILOG],length)
 400
 401                 COUNT(userenv[JIT_RETURN],length)
 402         }
 403
 404         return -1;
 405 }
 406
 407 F_FASTCALL CELL primitive_jit_compile(CELL quot, F_STACK_FRAME *stack)
 408 {
 409         stack_chain->callstack_top = stack;
 410         REGISTER_ROOT(quot);
 411         jit_compile(quot,true);
 412         UNREGISTER_ROOT(quot);
 413         return quot;
 414 }
 415
 416 /* push a new quotation on the stack */
 417 void primitive_array_to_quotation(void)
 418 {
 419         F_QUOTATION *quot = allot_object(QUOTATION_TYPE,sizeof(F_QUOTATION));
 420         quot->array = dpeek();
 421         quot->xt = lazy_jit_compile;
 422         quot->compiledp = F;
 423         drepl(tag_object(quot));
 424 }
 425
 426 void primitive_quotation_xt(void)
 427 {
 428         F_QUOTATION *quot = untag_quotation(dpeek());
 429         drepl(allot_cell((CELL)quot->xt));
 430 }