basis/bootstrap/assembler/ppc.factor

   1 ! Copyright (C) 2011 Erik Charlebois
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: bootstrap.image.private kernel kernel.private namespaces
   4 system cpu.ppc.assembler compiler.units compiler.constants math
   5 math.private math.ranges layouts words vocabs slots.private
   6 locals locals.backend generic.single.private fry sequences
   7 threads.private strings.private ;
   8 FROM: cpu.ppc.assembler => B ;
   9 IN: bootstrap.ppc
  10
  11 : jit-call ( string -- )
  12     dup
  13     0 swap jit-load-dlsym
  14     0 MTLR
  15     jit-load-dlsym-toc
  16     BLRL ;
  17
  18 : jit-call-quot ( -- )
  19     4 quot-entry-point-offset LI
  20     4 3 4 jit-load-cell-x
  21     4 MTLR
  22     BLRL ;
  23
  24 : jit-jump-quot ( -- )
  25     4 quot-entry-point-offset LI
  26     4 3 4 jit-load-cell-x
  27     4 MTCTR
  28     BCTR ;
  29
  30 : stack-frame ( -- n )
  31     reserved-size factor-area-size + 16 align ;
  32
  33 : save-at ( m -- n ) reserved-size + param-size + ;
  34
  35 : save-int ( reg off -- ) [ 1 ] dip save-at jit-save-int ;
  36 : save-fp  ( reg off -- ) [ 1 ] dip save-at STFD ;
  37 : save-vec ( reg offt -- ) save-at 11 swap LI 11 1 STVXL ;
  38 : restore-int ( reg off -- ) [ 1 ] dip save-at jit-load-int ;
  39 : restore-fp  ( reg off -- ) [ 1 ] dip save-at LFD ;
  40 : restore-vec ( reg offt -- ) save-at 11 swap LI 11 1 LVXL ;
  41
  42 ! Stop using intervals here.
  43 : nv-fp-regs  ( -- seq ) 14 31 [a..b] ;
  44 : nv-vec-regs ( -- seq ) 20 31 [a..b] ;
  45
  46 : saved-fp-regs-size  ( -- n ) 144 ;
  47 : saved-vec-regs-size ( -- n ) 192 ;
  48
  49 : callback-frame-size ( -- n )
  50     reserved-size
  51     param-size +
  52     saved-int-regs-size +
  53     saved-fp-regs-size +
  54     saved-vec-regs-size +
  55     16 align ;
  56
  57 : old-context-save-offset ( -- n )
  58     cell-size 20 * saved-fp-regs-size + saved-vec-regs-size + save-at ;
  59
  60 [
  61     ! Save old stack pointer
  62     11 1 MR
  63
  64     0 MFLR                                           ! Get return address
  65     0 1 lr-save jit-save-cell                        ! Stash return address
  66     1 1 callback-frame-size neg jit-save-cell-update ! Bump stack pointer and set back chain
  67
  68     ! Save all non-volatile registers
  69     nv-int-regs [ cell-size * save-int ] each-index
  70     nv-fp-regs [ 8 * saved-int-regs-size + save-fp  ] each-index
  71     ! nv-vec-regs [ 16 * saved-int-regs-size saved-fp-regs-size + + save-vec ] each-index
  72
  73     ! Stick old stack pointer in the frame register so callbacks
  74     ! can access their arguments
  75     frame-reg 11 MR
  76
  77     ! Load VM into vm-reg
  78     vm-reg jit-load-vm-arg
  79
  80     ! Save old context
  81     0 vm-reg vm-context-offset jit-load-cell
  82     0 1 old-context-save-offset jit-save-cell
  83
  84     ! Switch over to the spare context
  85     11 vm-reg vm-spare-context-offset jit-load-cell
  86     11 vm-reg vm-context-offset jit-save-cell
  87
  88     ! Save C callstack pointer and load Factor callstack
  89     1 11 context-callstack-save-offset jit-save-cell
  90     1 11 context-callstack-bottom-offset jit-load-cell
  91
  92     ! Load new data and retain stacks
  93     rs-reg 11 context-retainstack-offset jit-load-cell
  94     ds-reg 11 context-datastack-offset jit-load-cell
  95
  96     ! Call into Factor code
  97     0 jit-load-entry-point-arg
  98     0 MTLR
  99     BLRL
 100
 101     ! Load VM again, pointlessly
 102     vm-reg jit-load-vm-arg
 103
 104     ! Load C callstack pointer
 105     11 vm-reg vm-context-offset jit-load-cell
 106     1 11 context-callstack-save-offset jit-load-cell
 107
 108     ! Load old context
 109     0 1 old-context-save-offset jit-load-cell
 110     0 vm-reg vm-context-offset jit-save-cell
 111
 112     ! Restore non-volatile registers
 113     ! nv-vec-regs [ 16 * saved-int-regs-size saved-float-regs-size + + restore-vec ] each-index
 114     nv-fp-regs [ 8 * saved-int-regs-size + restore-fp ] each-index
 115     nv-int-regs [ cell-size * restore-int ] each-index
 116
 117     1 1 callback-frame-size ADDI ! Bump stack back up
 118     0 1 lr-save jit-load-cell    ! Fetch return address
 119     0 MTLR                       ! Set up return
 120     BLR                          ! Branch back
 121 ] CALLBACK-STUB jit-define
 122
 123 : jit-conditional* ( test-quot false-quot -- )
 124     [ '[ 4 + @ ] ] dip jit-conditional ; inline
 125
 126 : jit-load-context ( -- )
 127     ctx-reg vm-reg vm-context-offset jit-load-cell ;
 128
 129 : jit-save-context ( -- )
 130     jit-load-context
 131     1 ctx-reg context-callstack-top-offset jit-save-cell
 132     ds-reg ctx-reg context-datastack-offset jit-save-cell
 133     rs-reg ctx-reg context-retainstack-offset jit-save-cell ;
 134
 135 : jit-restore-context ( -- )
 136     ds-reg ctx-reg context-datastack-offset jit-load-cell
 137     rs-reg ctx-reg context-retainstack-offset jit-load-cell ;
 138
 139 [
 140     0 MFLR
 141     0 1 lr-save jit-save-cell
 142     0 jit-load-this-arg
 143     0 1 cell-size 2 * neg jit-save-cell
 144     0 stack-frame LI
 145     0 1 cell-size 1 * neg jit-save-cell
 146     1 1 stack-frame neg jit-save-cell-update
 147 ] JIT-PROLOG jit-define
 148
 149 [
 150     3 jit-load-literal-arg
 151     3 ds-reg cell-size jit-save-cell-update
 152 ] JIT-PUSH-LITERAL jit-define
 153
 154 [
 155     jit-save-context
 156     3 vm-reg MR
 157     4 jit-load-dlsym-arg
 158     4 MTLR
 159     jit-load-dlsym-toc-arg ! Restore the TOC/GOT
 160     BLRL
 161     jit-restore-context
 162 ] JIT-PRIMITIVE jit-define
 163
 164 [
 165     0 BL rc-relative-ppc-3-pc rt-entry-point-pic jit-rel
 166 ] JIT-WORD-CALL jit-define
 167
 168 [
 169     6 jit-load-here-arg
 170     0 B rc-relative-ppc-3-pc rt-entry-point-pic-tail jit-rel
 171 ] JIT-WORD-JUMP jit-define
 172
 173 [
 174     3 ds-reg 0 jit-load-cell
 175     ds-reg dup cell-size SUBI
 176     0 3 \ f type-number jit-compare-cell-imm
 177     [ 0 swap BEQ ] [ 0 B rc-relative-ppc-3-pc rt-entry-point jit-rel ] jit-conditional*
 178     0 B rc-relative-ppc-3-pc rt-entry-point jit-rel
 179 ] JIT-IF jit-define
 180
 181 : jit->r ( -- )
 182     4 ds-reg 0 jit-load-cell
 183     ds-reg dup cell-size SUBI
 184     4 rs-reg cell-size jit-save-cell-update ;
 185
 186 : jit-2>r ( -- )
 187     4 ds-reg 0 jit-load-cell
 188     5 ds-reg cell-size neg jit-load-cell
 189     ds-reg dup 2 cell-size * SUBI
 190     rs-reg dup 2 cell-size * ADDI
 191     4 rs-reg 0 jit-save-cell
 192     5 rs-reg cell-size neg jit-save-cell ;
 193
 194 : jit-3>r ( -- )
 195     4 ds-reg 0 jit-load-cell
 196     5 ds-reg cell-size neg jit-load-cell
 197     6 ds-reg cell-size neg 2 * jit-load-cell
 198     ds-reg dup 3 cell-size * SUBI
 199     rs-reg dup 3 cell-size * ADDI
 200     4 rs-reg 0 jit-save-cell
 201     5 rs-reg cell-size neg jit-save-cell
 202     6 rs-reg cell-size neg 2 * jit-save-cell ;
 203
 204 : jit-r> ( -- )
 205     4 rs-reg 0 jit-load-cell
 206     rs-reg dup cell-size SUBI
 207     4 ds-reg cell-size jit-save-cell-update ;
 208
 209 : jit-2r> ( -- )
 210     4 rs-reg 0 jit-load-cell
 211     5 rs-reg cell-size neg jit-load-cell
 212     rs-reg dup 2 cell-size * SUBI
 213     ds-reg dup 2 cell-size * ADDI
 214     4 ds-reg 0 jit-save-cell
 215     5 ds-reg cell-size neg jit-save-cell ;
 216
 217 : jit-3r> ( -- )
 218     4 rs-reg 0 jit-load-cell
 219     5 rs-reg cell-size neg jit-load-cell
 220     6 rs-reg cell-size neg 2 * jit-load-cell
 221     rs-reg dup 3 cell-size * SUBI
 222     ds-reg dup 3 cell-size * ADDI
 223     4 ds-reg 0 jit-save-cell
 224     5 ds-reg cell-size neg jit-save-cell
 225     6 ds-reg cell-size neg 2 * jit-save-cell ;
 226
 227 [
 228     jit->r
 229     0 BL rc-relative-ppc-3-pc rt-entry-point jit-rel
 230     jit-r>
 231 ] JIT-DIP jit-define
 232
 233 [
 234     jit-2>r
 235     0 BL rc-relative-ppc-3-pc rt-entry-point jit-rel
 236     jit-2r>
 237 ] JIT-2DIP jit-define
 238
 239 [
 240     jit-3>r
 241     0 BL rc-relative-ppc-3-pc rt-entry-point jit-rel
 242     jit-3r>
 243 ] JIT-3DIP jit-define
 244
 245 [
 246     1 1 stack-frame ADDI
 247     0 1 lr-save jit-load-cell
 248     0 MTLR
 249 ] JIT-EPILOG jit-define
 250
 251 [ BLR ] JIT-RETURN jit-define
 252
 253 ! ! ! Polymorphic inline caches
 254
 255 ! Don't touch r6 here; it's used to pass the tail call site
 256 ! address for tail PICs
 257
 258 ! Load a value from a stack position
 259 [
 260     4 ds-reg 0 jit-load-cell rc-absolute-ppc-2 rt-untagged jit-rel
 261 ] PIC-LOAD jit-define
 262
 263 [ 4 4 tag-mask get ANDI. ] PIC-TAG jit-define
 264
 265 [
 266     3 4 MR
 267     4 4 tag-mask get ANDI.
 268     0 4 tuple type-number jit-compare-cell-imm
 269     [ 0 swap BNE ]
 270     [ 4 tuple-class-offset LI 4 3 4 jit-load-cell-x ]
 271     jit-conditional*
 272 ] PIC-TUPLE jit-define
 273
 274 [
 275     0 4 0 jit-compare-cell-imm rc-absolute-ppc-2 rt-untagged jit-rel
 276 ] PIC-CHECK-TAG jit-define
 277
 278 [
 279     5 jit-load-literal-arg
 280     0 4 5 jit-compare-cell
 281 ] PIC-CHECK-TUPLE jit-define
 282
 283 [
 284     [ 0 swap BNE ] [ 0 B rc-relative-ppc-3-pc rt-entry-point jit-rel ] jit-conditional*
 285 ] PIC-HIT jit-define
 286
 287 ! Inline cache miss entry points
 288 : jit-load-return-address ( -- ) 6 MFLR ;
 289
 290 ! These are always in tail position with an existing stack
 291 ! frame, and the stack. The frame setup takes this into account.
 292 : jit-inline-cache-miss ( -- )
 293     jit-save-context
 294     3 6 MR
 295     4 vm-reg MR
 296     ctx-reg 6 MR
 297     "inline_cache_miss" jit-call
 298     6 ctx-reg MR
 299     jit-load-context
 300     jit-restore-context ;
 301
 302 [ jit-load-return-address jit-inline-cache-miss ]
 303 [ 3 MTLR BLRL ]
 304 [ 3 MTCTR BCTR ]
 305 \ inline-cache-miss define-combinator-primitive
 306
 307 [ jit-inline-cache-miss ]
 308 [ 3 MTLR BLRL ]
 309 [ 3 MTCTR BCTR ]
 310 \ inline-cache-miss-tail define-combinator-primitive
 311
 312 ! ! ! Megamorphic caches
 313
 314 [
 315     ! class = ...
 316     3 4 MR
 317     4 4 tag-mask get ANDI. ! Mask and...
 318     4 4 tag-bits get jit-shift-left-logical-imm ! shift tag bits to fixnum
 319     0 4 tuple type-number tag-fixnum jit-compare-cell-imm
 320     [ 0 swap BNE ]
 321     [ 4 tuple-class-offset LI 4 3 4 jit-load-cell-x ]
 322     jit-conditional*
 323     ! cache = ...
 324     3 jit-load-literal-arg
 325     ! key = hashcode(class)
 326     5 4 jit-class-hashcode
 327     ! key &= cache.length - 1
 328     5 5 mega-cache-size get 1 - 4 * ANDI.
 329     ! cache += array-start-offset
 330     3 3 array-start-offset ADDI
 331     ! cache += key
 332     3 3 5 ADD
 333     ! if(get(cache) == class)
 334     6 3 0 jit-load-cell
 335     0 6 4 jit-compare-cell
 336     [ 0 swap BNE ]
 337     [
 338         ! megamorphic_cache_hits++
 339         4 jit-load-megamorphic-cache-arg
 340         5 4 0 jit-load-cell
 341         5 5 1 ADDI
 342         5 4 0 jit-save-cell
 343         ! ... goto get(cache + cell-size)
 344         5 word-entry-point-offset LI
 345         3 3 cell-size jit-load-cell
 346         3 3 5 jit-load-cell-x
 347         3 MTCTR
 348         BCTR
 349     ]
 350     jit-conditional*
 351     ! fall-through on miss
 352 ] MEGA-LOOKUP jit-define
 353
 354 ! ! ! Sub-primitives
 355
 356 ! Quotations and words
 357 [
 358     3 ds-reg 0 jit-load-cell
 359     ds-reg dup cell-size SUBI
 360 ]
 361 [ jit-call-quot ]
 362 [ jit-jump-quot ] \ (call) define-combinator-primitive
 363
 364 [
 365     3 ds-reg 0 jit-load-cell
 366     ds-reg dup cell-size SUBI
 367     4 word-entry-point-offset LI
 368     4 3 4 jit-load-cell-x
 369 ]
 370 [ 4 MTLR BLRL ]
 371 [ 4 MTCTR BCTR ] \ (execute) define-combinator-primitive
 372
 373 [
 374     3 ds-reg 0 jit-load-cell
 375     ds-reg dup cell-size SUBI
 376     4 word-entry-point-offset LI
 377     4 3 4 jit-load-cell-x
 378     4 MTCTR BCTR
 379 ] JIT-EXECUTE jit-define
 380
 381 [
 382     jit-save-context
 383     4 vm-reg MR
 384     "lazy_jit_compile" jit-call
 385 ]
 386 [ jit-call-quot ]
 387 [ jit-jump-quot ]
 388 \ lazy-jit-compile define-combinator-primitive
 389
 390 ! Comparisons
 391 : jit-compare ( insn -- )
 392     t jit-literal
 393     3 jit-load-literal-arg
 394     4 ds-reg 0 jit-load-cell
 395     5 ds-reg cell-size neg jit-load-cell-update
 396     0 5 4 jit-compare-cell
 397     [ 0 8 ] dip execute( cr offset -- )
 398     3 \ f type-number LI
 399     3 ds-reg 0 jit-save-cell ;
 400
 401 : jit-math ( insn -- )
 402     3 ds-reg 0 jit-load-cell
 403     4 ds-reg cell-size neg jit-load-cell-update
 404     [ 5 3 4 ] dip execute( dst src1 src2 -- )
 405     5 ds-reg 0 jit-save-cell ;
 406
 407 ! Overflowing fixnum arithmetic
 408 :: jit-overflow ( insn func -- )
 409     ds-reg ds-reg cell-size SUBI
 410     jit-save-context
 411     3 ds-reg 0 jit-load-cell
 412     4 ds-reg cell-size jit-load-cell
 413     0 0 LI
 414     0 MTXER
 415     6 4 3 insn call( d a s -- )
 416     6 ds-reg 0 jit-save-cell
 417     [ 0 swap BNS ]
 418     [
 419         5 vm-reg MR
 420         func jit-call
 421     ]
 422     jit-conditional* ;
 423
 424 ! Contexts
 425 :: jit-switch-context ( reg -- )
 426     7 0 LI
 427     7 1 lr-save jit-save-cell
 428
 429     ! Make the new context the current one
 430     ctx-reg reg MR
 431     ctx-reg vm-reg vm-context-offset jit-save-cell
 432
 433     ! Load new stack pointer
 434     1 ctx-reg context-callstack-top-offset jit-load-cell
 435
 436     ! Load new ds, rs registers
 437     jit-restore-context ;
 438
 439 : jit-pop-context-and-param ( -- )
 440     3 ds-reg 0 jit-load-cell
 441     4 alien-offset LI
 442     3 3 4 jit-load-cell-x
 443     4 ds-reg cell-size neg jit-load-cell
 444     ds-reg ds-reg cell-size 2 * SUBI ;
 445
 446 : jit-push-param ( -- )
 447     ds-reg ds-reg cell-size ADDI
 448     4 ds-reg 0 jit-save-cell ;
 449
 450 : jit-set-context ( -- )
 451     jit-pop-context-and-param
 452     jit-save-context
 453     3 jit-switch-context
 454     jit-push-param ;
 455
 456 : jit-pop-quot-and-param ( -- )
 457     3 ds-reg 0 jit-load-cell
 458     4 ds-reg cell-size neg jit-load-cell
 459     ds-reg ds-reg cell-size 2 * SUBI ;
 460
 461 : jit-start-context ( -- )
 462     ! Create the new context in return-reg. Have to save context
 463     ! twice, first before calling new_context() which may GC,
 464     ! and again after popping the two parameters from the stack.
 465     jit-save-context
 466     3 vm-reg MR
 467     "new_context" jit-call
 468
 469     6 3 MR
 470     jit-pop-quot-and-param
 471     jit-save-context
 472     6 jit-switch-context
 473     jit-push-param
 474     jit-jump-quot ;
 475
 476 : jit-delete-current-context ( -- )
 477     jit-load-context
 478     3 vm-reg MR
 479     "delete_context" jit-call ;
 480
 481 : jit-start-context-and-delete ( -- )
 482     jit-save-context
 483
 484     3 vm-reg MR
 485     "reset_context" jit-call
 486
 487     ctx-reg jit-switch-context
 488
 489     ! Pops the quotation from the stack and puts it in register 3
 490     3 ds-reg 0 jit-load-cell
 491     ds-reg ds-reg cell-size SUBI
 492     jit-jump-quot ;
 493
 494 ! # All ppc subprimitives
 495 {
 496     ! ## Contexts
 497     { (set-context) [ jit-set-context ] }
 498     { (set-context-and-delete) [
 499         jit-delete-current-context
 500         jit-set-context
 501     ] }
 502     { (start-context) [ jit-start-context ] }
 503     { (start-context-and-delete) [
 504         jit-start-context-and-delete
 505     ] }
 506
 507     ! ## Entry points
 508     { c-to-factor [
 509         frame-reg 3 MR
 510
 511         3 vm-reg MR
 512         "begin_callback" jit-call
 513
 514         jit-load-context
 515         jit-restore-context
 516
 517         ! Call quotation
 518         3 frame-reg MR
 519         jit-call-quot
 520
 521         jit-save-context
 522
 523         3 vm-reg MR
 524         "end_callback" jit-call
 525     ] }
 526     { unwind-native-frames [
 527         ! Unwind stack frames
 528         1 4 MR
 529
 530         ! Load VM pointer into vm-reg, since we're entering from
 531         ! C code
 532         vm-reg jit-load-vm
 533
 534         ! Load ds and rs registers
 535         jit-load-context
 536         jit-restore-context
 537
 538         ! We have changed the stack; load return address again
 539         0 1 lr-save jit-load-cell
 540         0 MTLR
 541
 542         ! Call quotation
 543         jit-jump-quot
 544     ] }
 545
 546     ! ## Fixnums
 547
 548     ! ### Add
 549     { fixnum+ [ [ ADDO. ] "overflow_fixnum_add" jit-overflow ] }
 550     { fixnum+fast [ \ ADD jit-math ] }
 551
 552     ! ### Bit stuff
 553     { fixnum-bitand [ \ AND jit-math ] }
 554     { fixnum-bitnot [
 555         3 ds-reg 0 jit-load-cell
 556         3 3 NOT
 557         3 3 tag-mask get XORI
 558         3 ds-reg 0 jit-save-cell
 559     ] }
 560     { fixnum-bitor [ \ OR jit-math ] }
 561     { fixnum-bitxor [ \ XOR jit-math ] }
 562     { fixnum-shift-fast [
 563         3 ds-reg 0 jit-load-cell ! Load amount to shift
 564         3 3 jit-shift-tag-bits   ! Shift out tag bits
 565         ds-reg ds-reg cell-size SUBI
 566         4 ds-reg 0 jit-load-cell ! Load value to shift
 567         5 4 3 jit-shift-left-logical    ! Shift left
 568         6 3 NEG                         ! Negate shift amount
 569         7 4 6 jit-shift-right-algebraic ! Shift right
 570         7 7 jit-mask-tag-bits           ! Mask out tag bits
 571         0 3 0 jit-compare-cell-imm
 572         [ 0 swap BGT ] [ 5 7 MR ] jit-conditional*
 573         5 ds-reg 0 jit-save-cell
 574     ] }
 575
 576     ! ### Comparisons
 577     { both-fixnums? [
 578         3 ds-reg 0 jit-load-cell
 579         ds-reg ds-reg cell-size SUBI
 580         4 ds-reg 0 jit-load-cell
 581         3 3 4 OR
 582         3 3 tag-mask get ANDI.
 583         4 \ f type-number LI
 584         0 3 0 jit-compare-cell-imm
 585         [ 0 swap BNE ] [ 4 1 tag-fixnum LI ] jit-conditional*
 586         4 ds-reg 0 jit-save-cell
 587     ] }
 588     { eq? [ \ BEQ jit-compare ] }
 589     { fixnum> [ \ BGT jit-compare ] }
 590     { fixnum>= [ \ BGE jit-compare ] }
 591     { fixnum< [ \ BLT jit-compare ] }
 592     { fixnum<= [ \ BLE jit-compare ] }
 593
 594     ! ### Div/mod
 595     { fixnum-mod [
 596         3 ds-reg 0 jit-load-cell
 597         ds-reg ds-reg cell-size SUBI
 598         4 ds-reg 0 jit-load-cell
 599         5 4 3 jit-divide
 600         6 5 3 jit-multiply-low
 601         7 4 6 SUB
 602         7 ds-reg 0 jit-save-cell
 603     ] }
 604     { fixnum/i-fast [
 605         3 ds-reg 0 jit-load-cell
 606         ds-reg ds-reg cell-size SUBI
 607         4 ds-reg 0 jit-load-cell
 608         5 4 3 jit-divide
 609         5 5 tag-bits get jit-shift-left-logical-imm
 610         5 ds-reg 0 jit-save-cell
 611     ] }
 612     { fixnum/mod-fast [
 613         3 ds-reg 0 jit-load-cell
 614         4 ds-reg cell-size neg jit-load-cell
 615         5 4 3 jit-divide
 616         6 5 3 jit-multiply-low
 617         7 4 6 SUB
 618         5 5 tag-bits get jit-shift-left-logical-imm
 619         5 ds-reg cell-size neg jit-save-cell
 620         7 ds-reg 0 jit-save-cell
 621     ] }
 622
 623     ! ### Mul
 624     { fixnum* [
 625         ds-reg ds-reg cell-size SUBI
 626         jit-save-context
 627         3 ds-reg 0 jit-load-cell
 628         3 3 jit-shift-tag-bits
 629         4 ds-reg cell-size jit-load-cell
 630         0 0 LI
 631         0 MTXER
 632         6 3 4 jit-multiply-low-ov-rc
 633         6 ds-reg 0 jit-save-cell
 634         [ 0 swap BNS ]
 635         [
 636             4 4 jit-shift-tag-bits
 637             5 vm-reg MR
 638             "overflow_fixnum_multiply" jit-call
 639         ]
 640         jit-conditional*
 641     ] }
 642     { fixnum*fast [
 643         3 ds-reg 0 jit-load-cell
 644         4 ds-reg cell-size neg jit-load-cell-update
 645         4 4 jit-shift-tag-bits
 646         5 3 4 jit-multiply-low
 647         5 ds-reg 0 jit-save-cell
 648     ] }
 649
 650     ! ### Sub
 651     { fixnum- [ [ SUBFO. ] "overflow_fixnum_subtract" jit-overflow ] }
 652     { fixnum-fast [ \ SUBF jit-math ] }
 653
 654     ! ## Locals
 655     { drop-locals [
 656         3 ds-reg 0 jit-load-cell
 657         ds-reg ds-reg cell-size SUBI
 658         3 3 jit-shift-fixnum-slot
 659         rs-reg rs-reg 3 SUB
 660     ] }
 661     { get-local [
 662         3 ds-reg 0 jit-load-cell
 663         3 3 jit-shift-fixnum-slot
 664         3 rs-reg 3 jit-load-cell-x
 665         3 ds-reg 0 jit-save-cell
 666     ] }
 667     { load-local [ jit->r ] }
 668
 669     ! ## Misc
 670     { set-callstack [
 671         7 0 LI
 672         7 1 lr-save jit-save-cell
 673
 674         ! Load callstack object
 675         6 ds-reg 0 jit-load-cell
 676         ds-reg ds-reg cell-size SUBI
 677         ! Get ctx->callstack_bottom
 678         jit-load-context
 679         3 ctx-reg context-callstack-bottom-offset jit-load-cell
 680         ! Get top of callstack object -- 'src' for memcpy
 681         4 6 callstack-top-offset ADDI
 682         ! Get callstack length, in bytes --- 'len' for memcpy
 683         7 callstack-length-offset LI
 684         5 6 7 jit-load-cell-x
 685         5 5 jit-shift-tag-bits
 686         ! Compute new stack pointer -- 'dst' for memcpy
 687         3 3 5 SUB
 688         ! Install new stack pointer
 689         1 3 MR
 690         ! Call memcpy; arguments are now in the correct registers
 691         1 1 -16 cell-size * jit-save-cell-update
 692         "factor_memcpy" jit-call
 693         1 1 0 jit-load-cell
 694         ! Return with new callstack
 695         0 1 lr-save jit-load-cell
 696         0 MTLR
 697         BLR
 698     ] }
 699
 700     ! ## Objects
 701     { slot [
 702         3 ds-reg 0 jit-load-cell   ! Load m
 703         4 ds-reg cell-size neg jit-load-cell-update ! Load obj
 704         3 3 jit-shift-fixnum-slot  ! Shift to a cell-size multiple
 705         4 4 jit-mask-tag-bits      ! Clear tag bits on obj
 706         3 4 3 jit-load-cell-x      ! Load cell at &obj[m]
 707         3 ds-reg 0 jit-save-cell   ! Push the result to the stack
 708     ] }
 709     { string-nth-fast [
 710         ! load string index from stack
 711         3 ds-reg cell-size neg jit-load-cell
 712         3 3 jit-shift-tag-bits
 713         ! load string from stack
 714         4 ds-reg 0 jit-load-cell
 715         ! load character
 716         4 4 string-offset ADDI
 717         3 3 4 LBZX
 718         3 3 tag-bits get jit-shift-left-logical-imm
 719         ! store character to stack
 720         ds-reg ds-reg cell-size SUBI
 721         3 ds-reg 0 jit-save-cell
 722     ] }
 723     { tag [
 724         3 ds-reg 0 jit-load-cell
 725         3 3 tag-mask get ANDI.
 726         3 3 tag-bits get jit-shift-left-logical-imm
 727         3 ds-reg 0 jit-save-cell
 728     ] }
 729
 730     ! ## Shufflers
 731
 732     ! ### Drops
 733     { drop [ ds-reg dup cell-size SUBI ] }
 734     { 2drop [ ds-reg dup 2 cell-size * SUBI ] }
 735     { 3drop [ ds-reg dup 3 cell-size * SUBI ] }
 736
 737     ! ### Dups
 738     { dup [
 739         3 ds-reg 0 jit-load-cell
 740         3 ds-reg cell-size jit-save-cell-update
 741     ] }
 742     { 2dup [
 743         3 ds-reg 0 jit-load-cell
 744         4 ds-reg cell-size neg jit-load-cell
 745         ds-reg dup 2 cell-size * ADDI
 746         3 ds-reg 0 jit-save-cell
 747         4 ds-reg cell-size neg jit-save-cell
 748     ] }
 749     { 3dup [
 750         3 ds-reg 0 jit-load-cell
 751         4 ds-reg cell-size neg jit-load-cell
 752         5 ds-reg cell-size neg 2 * jit-load-cell
 753         ds-reg dup cell-size 3 * ADDI
 754         3 ds-reg 0 jit-save-cell
 755         4 ds-reg cell-size neg jit-save-cell
 756         5 ds-reg cell-size neg 2 * jit-save-cell
 757     ] }
 758     { dupd [
 759         3 ds-reg 0 jit-load-cell
 760         4 ds-reg cell-size neg jit-load-cell
 761         4 ds-reg 0 jit-save-cell
 762         3 ds-reg cell-size jit-save-cell-update
 763     ] }
 764
 765     ! ### Misc shufflers
 766     { over [
 767         3 ds-reg cell-size neg jit-load-cell
 768         3 ds-reg cell-size jit-save-cell-update
 769     ] }
 770     { pick [
 771         3 ds-reg cell-size neg 2 * jit-load-cell
 772         3 ds-reg cell-size jit-save-cell-update
 773     ] }
 774
 775     ! ### Nips
 776     { nip [
 777         3 ds-reg 0 jit-load-cell
 778         ds-reg dup cell-size SUBI
 779         3 ds-reg 0 jit-save-cell
 780     ] }
 781     { 2nip [
 782         3 ds-reg 0 jit-load-cell
 783         ds-reg dup cell-size 2 * SUBI
 784         3 ds-reg 0 jit-save-cell
 785     ] }
 786
 787     ! ### Swaps
 788     { -rot [
 789         3 ds-reg 0 jit-load-cell
 790         4 ds-reg cell-size neg jit-load-cell
 791         5 ds-reg cell-size neg 2 * jit-load-cell
 792         3 ds-reg cell-size neg 2 * jit-save-cell
 793         5 ds-reg cell-size neg jit-save-cell
 794         4 ds-reg 0 jit-save-cell
 795     ] }
 796     { rot [
 797         3 ds-reg 0 jit-load-cell
 798         4 ds-reg cell-size neg jit-load-cell
 799         5 ds-reg cell-size neg 2 * jit-load-cell
 800         4 ds-reg cell-size neg 2 * jit-save-cell
 801         3 ds-reg cell-size neg jit-save-cell
 802         5 ds-reg 0 jit-save-cell
 803     ] }
 804     { swap [
 805         3 ds-reg 0 jit-load-cell
 806         4 ds-reg cell-size neg jit-load-cell
 807         3 ds-reg cell-size neg jit-save-cell
 808         4 ds-reg 0 jit-save-cell
 809     ] }
 810     { swapd [
 811         3 ds-reg cell-size neg jit-load-cell
 812         4 ds-reg cell-size neg 2 * jit-load-cell
 813         3 ds-reg cell-size neg 2 * jit-save-cell
 814         4 ds-reg cell-size neg jit-save-cell
 815     ] }
 816 } define-sub-primitives
 817
 818 [ "bootstrap.ppc" forget-vocab ] with-compilation-unit