basis/cpu/ppc/bootstrap.factor

   1 ! Copyright (C) 2007, 2008 Slava Pestov.\r
   2 ! See http://factorcode.org/license.txt for BSD license.\r
   3 USING: bootstrap.image.private kernel kernel.private namespaces\r
   4 system cpu.ppc.assembler compiler.codegen.fixup compiler.units\r
   5 compiler.constants math math.private layouts words\r
   6 vocabs slots.private locals.backend ;\r
   7 FROM: cpu.ppc.assembler => B ;\r
   8 IN: bootstrap.ppc\r
   9 \r
  10 4 \ cell set\r
  11 big-endian on\r
  12 \r
  13 CONSTANT: ds-reg 13\r
  14 CONSTANT: rs-reg 14\r
  15 \r
  16 : factor-area-size ( -- n ) 4 bootstrap-cells ;\r
  17 \r
  18 : stack-frame ( -- n )\r
  19     factor-area-size c-area-size + 4 bootstrap-cells align ;\r
  20 \r
  21 : next-save ( -- n ) stack-frame bootstrap-cell - ;\r
  22 : xt-save ( -- n ) stack-frame 2 bootstrap-cells - ;\r
  23 \r
  24 [\r
  25     0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel\r
  26     11 3 profile-count-offset LWZ\r
  27     11 11 1 tag-fixnum ADDI\r
  28     11 3 profile-count-offset STW\r
  29     11 3 word-code-offset LWZ\r
  30     11 11 compiled-header-size ADDI\r
  31     11 MTCTR\r
  32     BCTR\r
  33 ] jit-profiling jit-define\r
  34 \r
  35 [\r
  36     0 3 LOAD32 rc-absolute-ppc-2/2 rt-this jit-rel\r
  37     0 MFLR\r
  38     1 1 stack-frame SUBI\r
  39     3 1 xt-save STW\r
  40     stack-frame 3 LI\r
  41     3 1 next-save STW\r
  42     0 1 lr-save stack-frame + STW\r
  43 ] jit-prolog jit-define\r
  44 \r
  45 [\r
  46     0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel\r
  47     3 ds-reg 4 STWU\r
  48 ] jit-push-immediate jit-define\r
  49 \r
  50 [\r
  51     0 3 LOAD32 rc-absolute-ppc-2/2 rt-stack-chain jit-rel\r
  52     4 3 0 LWZ\r
  53     1 4 0 STW\r
  54     4 0 swap LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel\r
  55     0 5 LOAD32 rc-absolute-ppc-2/2 rt-primitive jit-rel\r
  56     5 MTCTR\r
  57     BCTR\r
  58 ] jit-primitive jit-define\r
  59 \r
  60 [ 0 BL rc-relative-ppc-3 rt-xt-pic jit-rel ] jit-word-call jit-define\r
  61 \r
  62 [\r
  63     0 6 LOAD32 rc-absolute-ppc-2/2 rt-here jit-rel\r
  64     0 B rc-relative-ppc-3 rt-xt-pic-tail jit-rel\r
  65 ] jit-word-jump jit-define\r
  66 \r
  67 [ 0 B rc-relative-ppc-3 rt-xt jit-rel ] jit-word-special jit-define\r
  68 \r
  69 [\r
  70     3 ds-reg 0 LWZ\r
  71     ds-reg dup 4 SUBI\r
  72     0 3 \ f type-number CMPI\r
  73     2 BEQ\r
  74     0 B rc-relative-ppc-3 rt-xt jit-rel\r
  75     0 B rc-relative-ppc-3 rt-xt jit-rel\r
  76 ] jit-if jit-define\r
  77 \r
  78 : jit->r ( -- )\r
  79     4 ds-reg 0 LWZ\r
  80     ds-reg dup 4 SUBI\r
  81     4 rs-reg 4 STWU ;\r
  82 \r
  83 : jit-2>r ( -- )\r
  84     4 ds-reg 0 LWZ\r
  85     5 ds-reg -4 LWZ\r
  86     ds-reg dup 8 SUBI\r
  87     rs-reg dup 8 ADDI\r
  88     4 rs-reg 0 STW\r
  89     5 rs-reg -4 STW ;\r
  90 \r
  91 : jit-3>r ( -- )\r
  92     4 ds-reg 0 LWZ\r
  93     5 ds-reg -4 LWZ\r
  94     6 ds-reg -8 LWZ\r
  95     ds-reg dup 12 SUBI\r
  96     rs-reg dup 12 ADDI\r
  97     4 rs-reg 0 STW\r
  98     5 rs-reg -4 STW\r
  99     6 rs-reg -8 STW ;\r
 100 \r
 101 : jit-r> ( -- )\r
 102     4 rs-reg 0 LWZ\r
 103     rs-reg dup 4 SUBI\r
 104     4 ds-reg 4 STWU ;\r
 105 \r
 106 : jit-2r> ( -- )\r
 107     4 rs-reg 0 LWZ\r
 108     5 rs-reg -4 LWZ\r
 109     rs-reg dup 8 SUBI\r
 110     ds-reg dup 8 ADDI\r
 111     4 ds-reg 0 STW\r
 112     5 ds-reg -4 STW ;\r
 113 \r
 114 : jit-3r> ( -- )\r
 115     4 rs-reg 0 LWZ\r
 116     5 rs-reg -4 LWZ\r
 117     6 rs-reg -8 LWZ\r
 118     rs-reg dup 12 SUBI\r
 119     ds-reg dup 12 ADDI\r
 120     4 ds-reg 0 STW\r
 121     5 ds-reg -4 STW\r
 122     6 ds-reg -8 STW ;\r
 123 \r
 124 [\r
 125     jit->r\r
 126     0 BL rc-relative-ppc-3 rt-xt jit-rel\r
 127     jit-r>\r
 128 ] jit-dip jit-define\r
 129 \r
 130 [\r
 131     jit-2>r\r
 132     0 BL rc-relative-ppc-3 rt-xt jit-rel\r
 133     jit-2r>\r
 134 ] jit-2dip jit-define\r
 135 \r
 136 [\r
 137     jit-3>r\r
 138     0 BL rc-relative-ppc-3 rt-xt jit-rel\r
 139     jit-3r>\r
 140 ] jit-3dip jit-define\r
 141 \r
 142 : prepare-(execute) ( -- operand )\r
 143     3 ds-reg 0 LWZ\r
 144     ds-reg dup 4 SUBI\r
 145     4 3 word-xt-offset LWZ\r
 146     4 ;\r
 147 \r
 148 [ prepare-(execute) MTCTR BCTR ] jit-execute-jump jit-define\r
 149 \r
 150 [ prepare-(execute) MTLR BLRL ] jit-execute-call jit-define\r
 151 \r
 152 [\r
 153     0 1 lr-save stack-frame + LWZ\r
 154     1 1 stack-frame ADDI\r
 155     0 MTLR\r
 156 ] jit-epilog jit-define\r
 157 \r
 158 [ BLR ] jit-return jit-define\r
 159 \r
 160 ! ! ! Polymorphic inline caches\r
 161 \r
 162 ! Don't touch r6 here; it's used to pass the tail call site\r
 163 ! address for tail PICs\r
 164 \r
 165 ! Load a value from a stack position\r
 166 [\r
 167     4 ds-reg 0 LWZ rc-absolute-ppc-2 rt-untagged jit-rel\r
 168 ] pic-load jit-define\r
 169 \r
 170 ! Tag\r
 171 : load-tag ( -- )\r
 172     4 4 tag-mask get ANDI\r
 173     4 4 tag-bits get SLWI ;\r
 174 \r
 175 [ load-tag ] pic-tag jit-define\r
 176 \r
 177 ! Tuple\r
 178 [\r
 179     3 4 MR\r
 180     load-tag\r
 181     0 4 tuple type-number tag-fixnum CMPI\r
 182     2 BNE\r
 183     4 3 tuple type-number neg bootstrap-cell + LWZ\r
 184 ] pic-tuple jit-define\r
 185 \r
 186 [\r
 187     0 4 0 CMPI rc-absolute-ppc-2 rt-immediate jit-rel\r
 188 ] pic-check-tag jit-define\r
 189 \r
 190 [\r
 191     0 5 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel\r
 192     4 0 5 CMP\r
 193 ] pic-check-tuple jit-define\r
 194 \r
 195 [ 2 BNE 0 B rc-relative-ppc-3 rt-xt jit-rel ] pic-hit jit-define\r
 196 \r
 197 ! ! ! Megamorphic caches\r
 198 \r
 199 [\r
 200     ! cache = ...\r
 201     0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel\r
 202     ! key = hashcode(class)\r
 203     5 4 3 SRAWI\r
 204     6 4 8 SRAWI\r
 205     5 5 6 ADD\r
 206     6 4 13 SRAWI\r
 207     5 5 6 ADD\r
 208     5 5 3 SLWI\r
 209     ! key &= cache.length - 1\r
 210     5 5 mega-cache-size get 1 - bootstrap-cell * ANDI\r
 211     ! cache += array-start-offset\r
 212     3 3 array-start-offset ADDI\r
 213     ! cache += key\r
 214     3 3 5 ADD\r
 215     ! if(get(cache) == class)\r
 216     6 3 0 LWZ\r
 217     6 0 4 CMP\r
 218     10 BNE\r
 219     ! megamorphic_cache_hits++\r
 220     0 4 LOAD32 rc-absolute-ppc-2/2 rt-megamorphic-cache-hits jit-rel\r
 221     5 4 0 LWZ\r
 222     5 5 1 ADDI\r
 223     5 4 0 STW\r
 224     ! ... goto get(cache + bootstrap-cell)\r
 225     3 3 4 LWZ\r
 226     3 3 word-xt-offset LWZ\r
 227     3 MTCTR\r
 228     BCTR\r
 229     ! fall-through on miss\r
 230 ] mega-lookup jit-define\r
 231 \r
 232 [\r
 233     0 2 LOAD32 rc-absolute-ppc-2/2 rt-xt jit-rel\r
 234     2 MTCTR\r
 235     BCTR\r
 236 ] callback-stub jit-define\r
 237 \r
 238 ! ! ! Sub-primitives\r
 239 \r
 240 ! Quotations and words\r
 241 [\r
 242     3 ds-reg 0 LWZ\r
 243     ds-reg dup 4 SUBI\r
 244     4 0 swap LOAD32 0 jit-literal rc-absolute-ppc-2/2 rt-vm jit-rel\r
 245     5 3 quot-xt-offset LWZ\r
 246     5 MTCTR\r
 247     BCTR\r
 248 ] \ (call) define-sub-primitive\r
 249 \r
 250 ! Objects\r
 251 [\r
 252     3 ds-reg 0 LWZ\r
 253     3 3 tag-mask get ANDI\r
 254     3 3 tag-bits get SLWI\r
 255     3 ds-reg 0 STW\r
 256 ] \ tag define-sub-primitive\r
 257 \r
 258 [\r
 259     3 ds-reg 0 LWZ\r
 260     4 ds-reg -4 LWZU\r
 261     3 3 2 SRAWI\r
 262     4 4 0 0 31 tag-bits get - RLWINM\r
 263     4 3 3 LWZX\r
 264     3 ds-reg 0 STW\r
 265 ] \ slot define-sub-primitive\r
 266 \r
 267 ! Shufflers\r
 268 [\r
 269     ds-reg dup 4 SUBI\r
 270 ] \ drop define-sub-primitive\r
 271 \r
 272 [\r
 273     ds-reg dup 8 SUBI\r
 274 ] \ 2drop define-sub-primitive\r
 275 \r
 276 [\r
 277     ds-reg dup 12 SUBI\r
 278 ] \ 3drop define-sub-primitive\r
 279 \r
 280 [\r
 281     3 ds-reg 0 LWZ\r
 282     3 ds-reg 4 STWU\r
 283 ] \ dup define-sub-primitive\r
 284 \r
 285 [\r
 286     3 ds-reg 0 LWZ\r
 287     4 ds-reg -4 LWZ\r
 288     ds-reg dup 8 ADDI\r
 289     3 ds-reg 0 STW\r
 290     4 ds-reg -4 STW\r
 291 ] \ 2dup define-sub-primitive\r
 292 \r
 293 [\r
 294     3 ds-reg 0 LWZ\r
 295     4 ds-reg -4 LWZ\r
 296     5 ds-reg -8 LWZ\r
 297     ds-reg dup 12 ADDI\r
 298     3 ds-reg 0 STW\r
 299     4 ds-reg -4 STW\r
 300     5 ds-reg -8 STW\r
 301 ] \ 3dup define-sub-primitive\r
 302 \r
 303 [\r
 304     3 ds-reg 0 LWZ\r
 305     ds-reg dup 4 SUBI\r
 306     3 ds-reg 0 STW\r
 307 ] \ nip define-sub-primitive\r
 308 \r
 309 [\r
 310     3 ds-reg 0 LWZ\r
 311     ds-reg dup 8 SUBI\r
 312     3 ds-reg 0 STW\r
 313 ] \ 2nip define-sub-primitive\r
 314 \r
 315 [\r
 316     3 ds-reg -4 LWZ\r
 317     3 ds-reg 4 STWU\r
 318 ] \ over define-sub-primitive\r
 319 \r
 320 [\r
 321     3 ds-reg -8 LWZ\r
 322     3 ds-reg 4 STWU\r
 323 ] \ pick define-sub-primitive\r
 324 \r
 325 [\r
 326     3 ds-reg 0 LWZ\r
 327     4 ds-reg -4 LWZ\r
 328     4 ds-reg 0 STW\r
 329     3 ds-reg 4 STWU\r
 330 ] \ dupd define-sub-primitive\r
 331 \r
 332 [\r
 333     3 ds-reg 0 LWZ\r
 334     4 ds-reg -4 LWZ\r
 335     3 ds-reg -4 STW\r
 336     4 ds-reg 0 STW\r
 337 ] \ swap define-sub-primitive\r
 338 \r
 339 [\r
 340     3 ds-reg -4 LWZ\r
 341     4 ds-reg -8 LWZ\r
 342     3 ds-reg -8 STW\r
 343     4 ds-reg -4 STW\r
 344 ] \ swapd define-sub-primitive\r
 345 \r
 346 [\r
 347     3 ds-reg 0 LWZ\r
 348     4 ds-reg -4 LWZ\r
 349     5 ds-reg -8 LWZ\r
 350     4 ds-reg -8 STW\r
 351     3 ds-reg -4 STW\r
 352     5 ds-reg 0 STW\r
 353 ] \ rot define-sub-primitive\r
 354 \r
 355 [\r
 356     3 ds-reg 0 LWZ\r
 357     4 ds-reg -4 LWZ\r
 358     5 ds-reg -8 LWZ\r
 359     3 ds-reg -8 STW\r
 360     5 ds-reg -4 STW\r
 361     4 ds-reg 0 STW\r
 362 ] \ -rot define-sub-primitive\r
 363 \r
 364 [ jit->r ] \ load-local define-sub-primitive\r
 365 \r
 366 ! Comparisons\r
 367 : jit-compare ( insn -- )\r
 368     t jit-literal\r
 369     0 3 LOAD32 rc-absolute-ppc-2/2 rt-immediate jit-rel\r
 370     4 ds-reg 0 LWZ\r
 371     5 ds-reg -4 LWZU\r
 372     5 0 4 CMP\r
 373     2 swap execute( offset -- ) ! magic number\r
 374     \ f type-number 3 LI\r
 375     3 ds-reg 0 STW ;\r
 376 \r
 377 : define-jit-compare ( insn word -- )\r
 378     [ [ jit-compare ] curry ] dip define-sub-primitive ;\r
 379 \r
 380 \ BEQ \ eq? define-jit-compare\r
 381 \ BGE \ fixnum>= define-jit-compare\r
 382 \ BLE \ fixnum<= define-jit-compare\r
 383 \ BGT \ fixnum> define-jit-compare\r
 384 \ BLT \ fixnum< define-jit-compare\r
 385 \r
 386 ! Math\r
 387 [\r
 388     3 ds-reg 0 LWZ\r
 389     ds-reg ds-reg 4 SUBI\r
 390     4 ds-reg 0 LWZ\r
 391     3 3 4 OR\r
 392     3 3 tag-mask get ANDI\r
 393     \ f type-number 4 LI\r
 394     0 3 0 CMPI\r
 395     2 BNE\r
 396     1 tag-fixnum 4 LI\r
 397     4 ds-reg 0 STW\r
 398 ] \ both-fixnums? define-sub-primitive\r
 399 \r
 400 : jit-math ( insn -- )\r
 401     3 ds-reg 0 LWZ\r
 402     4 ds-reg -4 LWZU\r
 403     [ 5 3 4 ] dip execute( dst src1 src2 -- )\r
 404     5 ds-reg 0 STW ;\r
 405 \r
 406 [ \ ADD jit-math ] \ fixnum+fast define-sub-primitive\r
 407 \r
 408 [ \ SUBF jit-math ] \ fixnum-fast define-sub-primitive\r
 409 \r
 410 [\r
 411     3 ds-reg 0 LWZ\r
 412     4 ds-reg -4 LWZU\r
 413     4 4 tag-bits get SRAWI\r
 414     5 3 4 MULLW\r
 415     5 ds-reg 0 STW\r
 416 ] \ fixnum*fast define-sub-primitive\r
 417 \r
 418 [ \ AND jit-math ] \ fixnum-bitand define-sub-primitive\r
 419 \r
 420 [ \ OR jit-math ] \ fixnum-bitor define-sub-primitive\r
 421 \r
 422 [ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive\r
 423 \r
 424 [\r
 425     3 ds-reg 0 LWZ\r
 426     3 3 NOT\r
 427     3 3 tag-mask get XORI\r
 428     3 ds-reg 0 STW\r
 429 ] \ fixnum-bitnot define-sub-primitive\r
 430 \r
 431 [\r
 432     3 ds-reg 0 LWZ\r
 433     3 3 tag-bits get SRAWI\r
 434     ds-reg ds-reg 4 SUBI\r
 435     4 ds-reg 0 LWZ\r
 436     5 4 3 SLW\r
 437     6 3 NEG\r
 438     7 4 6 SRAW\r
 439     7 7 0 0 31 tag-bits get - RLWINM\r
 440     0 3 0 CMPI\r
 441     2 BGT\r
 442     5 7 MR\r
 443     5 ds-reg 0 STW\r
 444 ] \ fixnum-shift-fast define-sub-primitive\r
 445 \r
 446 [\r
 447     3 ds-reg 0 LWZ\r
 448     ds-reg ds-reg 4 SUBI\r
 449     4 ds-reg 0 LWZ\r
 450     5 4 3 DIVW\r
 451     6 5 3 MULLW\r
 452     7 6 4 SUBF\r
 453     7 ds-reg 0 STW\r
 454 ] \ fixnum-mod define-sub-primitive\r
 455 \r
 456 [\r
 457     3 ds-reg 0 LWZ\r
 458     ds-reg ds-reg 4 SUBI\r
 459     4 ds-reg 0 LWZ\r
 460     5 4 3 DIVW\r
 461     5 5 tag-bits get SLWI\r
 462     5 ds-reg 0 STW\r
 463 ] \ fixnum/i-fast define-sub-primitive\r
 464 \r
 465 [\r
 466     3 ds-reg 0 LWZ\r
 467     4 ds-reg -4 LWZ\r
 468     5 4 3 DIVW\r
 469     6 5 3 MULLW\r
 470     7 6 4 SUBF\r
 471     5 5 tag-bits get SLWI\r
 472     5 ds-reg -4 STW\r
 473     7 ds-reg 0 STW\r
 474 ] \ fixnum/mod-fast define-sub-primitive\r
 475 \r
 476 [\r
 477     3 ds-reg 0 LWZ\r
 478     3 3 1 SRAWI\r
 479     rs-reg 3 3 LWZX\r
 480     3 ds-reg 0 STW\r
 481 ] \ get-local define-sub-primitive\r
 482 \r
 483 [\r
 484     3 ds-reg 0 LWZ\r
 485     ds-reg ds-reg 4 SUBI\r
 486     3 3 1 SRAWI\r
 487     rs-reg 3 rs-reg SUBF\r
 488 ] \ drop-locals define-sub-primitive\r
 489 \r
 490 [ "bootstrap.ppc" forget-vocab ] with-compilation-unit\r