basis/bootstrap/assembler/arm.64.factor

   1 ! Copyright (C) 2020 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: bootstrap.image.private compiler.codegen.relocation
   4 compiler.constants compiler.units cpu.arm.assembler
   5 cpu.arm.assembler.opcodes generic.single.private
   6 kernel kernel.private layouts locals.backend
   7 math math.private memory namespaces sequences slots.private
   8 strings.private threads.private vocabs ;
   9 IN: bootstrap.assembler.arm
  10
  11 8 \ cell set
  12
  13 big-endian off
  14
  15 ! Stack frame
  16 ! https://docs.microsoft.com/en-us/cpp/build/arm64-exception-handling?view=vs-2019
  17
  18 ! x0    Volatile        Parameter/scratch register 1, result register
  19 ! x1-x7 Volatile        Parameter/scratch register 2-8
  20 ! x8-x15        Volatile        Scratch registers
  21 ! x16-x17       Volatile        Intra-procedure-call scratch registers
  22 ! x18   Non-volatile    Platform register: in kernel mode, points to KPCR for the current processor;
  23 !   in user mode, points to TEB
  24 ! x19-x28       Non-volatile    Scratch registers
  25 ! x29/fp        Non-volatile    Frame pointer
  26 ! x30/lr        Non-volatile    Link registers
  27
  28 : stack-frame-size ( -- n ) 4 bootstrap-cells ;
  29 : volatile-regs ( -- seq ) { X0 X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15 X16 X17 } ;
  30 : nv-regs ( -- seq ) { X18 X19 X20 X21 X22 X23 X24 X25 X26 X27 X28 X29 X30 } ;
  31
  32 ! callee-save = non-volatile aka call-preserved
  33
  34 ! x30 is the link register (used to return from subroutines)
  35 ! x29 is the frame register
  36 ! x19 to x29 are callee-saved
  37 ! x18 is the 'platform register', used for some operating-system-specific special purpose,
  38 !   or an additional caller-saved register
  39 ! x16 and x17 are the Intra-Procedure-call scratch register
  40 ! x9 to x15: used to hold local variables (caller saved)
  41 ! x8: used to hold indirect return value address
  42 ! x0 to x7: used to hold argument values passed to a subroutine, and also hold
  43 !   results returned from a subroutine
  44
  45
  46 ! https://en.wikichip.org/wiki/arm/aarch64
  47 ! Generally, X0 through X18 can corrupt while X19-X29 must be preserved
  48 ! Register   Role    Requirement
  49 ! X0 -  X7   Parameter/result registers   Can Corrupt
  50 ! X8         Indirect result location register
  51 ! X9 -  X15  Temporary registers
  52 ! X16 - X17  Intra-procedure call temporary
  53 ! X18        Platform register, otherwise temporary
  54
  55 ! X19 - X29    Callee-saved register    Must preserve
  56 ! X30    Link Register    Can Corrupt
  57
  58 : arg1 ( -- reg ) X0 ;
  59 : arg2 ( -- reg ) X1 ;
  60 : arg3 ( -- reg ) X2 ;
  61 : arg4 ( -- reg ) X3 ;
  62 : red-zone-size ( -- n ) 16 ;
  63
  64 : shift-arg ( -- reg ) X1 ;
  65 : div-arg ( -- reg ) X0 ;
  66 : mod-arg ( -- reg ) X2 ;
  67
  68 ! caller-saved registers X9-X15
  69 ! callee-saved registers X19-X29
  70 : temp0 ( -- reg ) X9 ;
  71 : temp1 ( -- reg ) X10 ;
  72 : temp2 ( -- reg ) X11 ;
  73 : temp3 ( -- reg ) X12 ;
  74
  75
  76
  77 ! : pic-tail-reg ( -- reg ) RBX ;
  78 : return-reg ( -- reg ) X0 ;
  79 ! : nv-reg ( -- reg ) RBX ;
  80 ! : stack-reg ( -- reg ) RSP ;
  81 ! : frame-reg ( -- reg ) RBP ;
  82 ! : link-reg ( -- reg ) R11 ;
  83 ! : ctx-reg ( -- reg ) R12 ;
  84 : vm-reg ( -- reg ) X7 ;
  85 : ds-reg ( -- reg ) X5 ;
  86 : rs-reg ( -- reg ) X6 ;
  87 ! : fixnum>slot@ ( -- ) temp0 1 SAR ;
  88 ! : rex-length ( -- n ) 1 ;
  89
  90 ! rc-absolute-cell is just CONSTANT: 0
  91 : jit-call ( name -- )
  92     0 X0 MOVwi64
  93     f rc-absolute-cell rel-dlsym
  94     X0 BR ;
  95     ! RAX 0 MOV f rc-absolute-cell rel-dlsym
  96     ! RAX CALL ;
  97
  98 :: jit-call-1arg ( arg1s name -- )
  99     arg1s arg1 MOVr64
 100     name jit-call ;
 101     ! arg1 arg1s MOVr64
 102     ! name jit-call ;
 103
 104 :: jit-call-2arg ( arg1s arg2s name -- )
 105     arg1s arg1 MOVr64
 106     arg2s arg2 MOVr64
 107     name jit-call ;
 108     ! arg1 arg1s MOV
 109     ! arg2 arg2s MOV
 110     ! name jit-call ;
 111
 112 [
 113     ! pic-tail-reg 5 [RIP+] LEA
 114     ! 0 JMP f rc-relative rel-word-pic-tail
 115 ] JIT-WORD-JUMP jit-define
 116
 117 : jit-load-vm ( -- )
 118     ! no-op on x86-64. in factor contexts vm-reg always contains the
 119     ! vm pointer.
 120     ;
 121
 122 : jit-load-context ( -- ) ;
 123     ! ctx-reg vm-reg vm-context-offset [+] MOV ;
 124
 125 : jit-save-context ( -- ) ;
 126     ! jit-load-context
 127     ! The reason for -8 I think is because we are anticipating a CALL
 128     ! instruction. After the call instruction, the contexts frame_top
 129     ! will point to the origin jump address.
 130     ! R11 RSP -8 [+] LEA
 131     ! ctx-reg context-callstack-top-offset [+] R11 MOV
 132     ! ctx-reg context-datastack-offset [+] ds-reg MOV
 133     ! ctx-reg context-retainstack-offset [+] rs-reg MOV ;
 134
 135 ! ctx-reg must already have been loaded
 136 : jit-restore-context ( -- ) ;
 137     ! ds-reg ctx-reg context-datastack-offset [+] MOV
 138     ! rs-reg ctx-reg context-retainstack-offset [+] MOV ;
 139
 140
 141 [
 142     ! ! ctx-reg is preserved across the call because it is non-volatile
 143     ! ! in the C ABI
 144     ! jit-save-context
 145     ! ! call the primitive
 146     ! arg1 vm-reg MOV
 147     ! RAX 0 MOV f f rc-absolute-cell rel-dlsym
 148     ! RAX CALL
 149     ! jit-restore-context
 150 ] JIT-PRIMITIVE jit-define
 151
 152
 153 : jit-jump-quot ( -- ) ;
 154     ! arg1 quot-entry-point-offset [+] JMP ;
 155
 156 : jit-call-quot ( -- )
 157     quot-entry-point-offset arg1 ADR
 158     arg1 BR ;
 159
 160     ! arg1 quot-entry-point-offset [+] CALL ;
 161
 162 : signal-handler-save-regs ( -- regs ) { } ;
 163     ! { RAX RCX RDX RBX RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15 } ;
 164
 165
 166 [
 167     ! temp2 0 MOV f rc-absolute-cell rel-literal
 168     ! temp1 temp2 CMP
 169 ] PIC-CHECK-TUPLE jit-define
 170
 171
 172
 173 : jit->r ( -- )
 174     1 bootstrap-cells rs-reg rs-reg ADDi64
 175     -1 bootstrap-cells ds-reg rs-reg LDR-post ;
 176
 177 : jit-r> ( -- )
 178     1 bootstrap-cells ds-reg ds-reg ADDi64
 179     -1 bootstrap-cells rs-reg ds-reg LDR-post ;
 180
 181 : jit-2>r ( -- )
 182     1 bootstrap-cells rs-reg rs-reg ADDi64
 183     -1 bootstrap-cells ds-reg rs-reg LDR-post
 184     1 bootstrap-cells rs-reg rs-reg ADDi64
 185     -1 bootstrap-cells ds-reg rs-reg LDR-post ;
 186
 187 : jit-2r> ( -- )
 188     1 bootstrap-cells ds-reg ds-reg ADDi64
 189     -1 bootstrap-cells rs-reg ds-reg LDR-post
 190     1 bootstrap-cells ds-reg ds-reg ADDi64
 191     -1 bootstrap-cells rs-reg ds-reg LDR-post ;
 192
 193 : jit-3>r ( -- )
 194     1 bootstrap-cells rs-reg rs-reg ADDi64
 195     -1 bootstrap-cells ds-reg rs-reg LDR-post
 196     1 bootstrap-cells rs-reg rs-reg ADDi64
 197     -1 bootstrap-cells ds-reg rs-reg LDR-post
 198     1 bootstrap-cells rs-reg rs-reg ADDi64
 199     -1 bootstrap-cells ds-reg rs-reg LDR-post ;
 200
 201 : jit-3r> ( -- )
 202     1 bootstrap-cells ds-reg ds-reg ADDi64
 203     -1 bootstrap-cells rs-reg ds-reg LDR-post
 204     1 bootstrap-cells ds-reg ds-reg ADDi64
 205     -1 bootstrap-cells rs-reg ds-reg LDR-post
 206     1 bootstrap-cells ds-reg ds-reg ADDi64
 207     -1 bootstrap-cells rs-reg ds-reg LDR-post ;
 208
 209 ! Contexts
 210 : jit-switch-context ( reg -- ) drop ;
 211     ! ! Push a bogus return address so the GC can track this frame back
 212     ! ! to the owner
 213     ! 0 CALL
 214
 215     ! ! Make the new context the current one
 216     ! ctx-reg swap MOV
 217     ! vm-reg vm-context-offset [+] ctx-reg MOV
 218
 219     ! ! Load new stack pointer
 220     ! RSP ctx-reg context-callstack-top-offset [+] MOV
 221
 222     ! ! Load new ds, rs registers
 223     ! jit-restore-context
 224
 225     ! ctx-reg jit-update-tib ;
 226
 227 : jit-pop-context-and-param ( -- ) ;
 228     ! arg1 ds-reg [] MOV
 229     ! arg1 arg1 alien-offset [+] MOV
 230     ! arg2 ds-reg -8 [+] MOV
 231     ! ds-reg 16 SUB ;
 232
 233 : jit-push-param ( -- ) ;
 234     ! ds-reg 8 ADD
 235     ! ds-reg [] arg2 MOV ;
 236
 237 : jit-set-context ( -- ) ;
 238     ! jit-pop-context-and-param
 239     ! jit-save-context
 240     ! arg1 jit-switch-context
 241     ! RSP 8 ADD
 242     ! jit-push-param ;
 243
 244 : jit-pop-quot-and-param ( -- ) ;
 245     ! arg1 ds-reg [] MOV
 246     ! arg2 ds-reg -8 [+] MOV
 247     ! ds-reg 16 SUB ;
 248
 249 : jit-start-context ( -- ) ;
 250     ! Create the new context in return-reg. Have to save context
 251     ! twice, first before calling new_context() which may GC,
 252     ! and again after popping the two parameters from the stack.
 253     ! jit-save-context
 254     ! vm-reg "new_context" jit-call-1arg
 255
 256     ! jit-pop-quot-and-param
 257     ! jit-save-context
 258     ! return-reg jit-switch-context
 259     ! jit-push-param
 260     ! jit-jump-quot ;
 261
 262 : jit-delete-current-context ( -- ) ;
 263     ! vm-reg "delete_context" jit-call-1arg ;
 264
 265 [
 266     ! jit->r
 267     ! 0 CALL f rc-relative rel-word
 268     ! jit-r>
 269 ] JIT-DIP jit-define
 270
 271
 272
 273
 274 [
 275     ! 0 [RIP+] EAX MOV rc-relative rel-safepoint
 276 ] JIT-SAFEPOINT jit-define
 277
 278 ! # All arm.64 subprimitives
 279
 280 {
 281     ! ## Contexts
 282     ! { (set-context) [ jit-set-context ] }
 283     ! { (set-context-and-delete) [
 284     !     jit-delete-current-context
 285     !     jit-set-context
 286     ! ] }
 287     ! { (start-context) [ jit-start-context ] }
 288     ! { (start-context-and-delete) [ jit-start-context-and-delete ] }
 289
 290     ! ## Entry points
 291     { c-to-factor [
 292         ! dst src MOV
 293         ! arg2 arg1 MOV
 294         ! vm-reg "begin_callback" jit-call-1arg
 295
 296         ! ! call the quotation
 297         ! arg1 return-reg MOV
 298         ! jit-call-quot
 299
 300         ! vm-reg "end_callback" jit-call-1arg
 301
 302         [
 303
 304             ! write()
 305             ! 68 X8 MOVwi64
 306             ! X2 MOVwi64
 307             ! 0 SVC
 308
 309             ! exit(42)
 310             9999 BRK
 311             42 X0 MOVwi64
 312             93 X8 MOVwi64
 313             0 SVC
 314
 315
 316
 317             ! Rn Rd MOVr64
 318             ! arg1 arg2 MOVr64
 319             ! vm-reg "begin_callback" jit-call-1arg
 320
 321             ! return-reg arg1 MOVr64 ! arg1 is return
 322             ! jit-call-quot
 323
 324             ! vm-reg "end_callback" jit-call-1arg
 325
 326         ] assemble-arm %
 327
 328     ] }
 329     ! { unwind-native-frames [ ] }
 330
 331     ! ## Math
 332     ! { fixnum+ [ [ ADD ] "overflow_fixnum_add" jit-overflow ] }
 333     ! { fixnum- [ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] }
 334     ! { fixnum* [
 335     !     ds-reg 8 SUB
 336     !     jit-save-context
 337     !     RCX ds-reg [] MOV
 338     !     RBX ds-reg 8 [+] MOV
 339     !     RBX tag-bits get SAR
 340     !     RAX RCX MOV
 341     !     RBX IMUL
 342     !     ds-reg [] RAX MOV
 343     !     [ JNO ]
 344     !     [
 345     !         arg1 RCX MOV
 346     !         arg1 tag-bits get SAR
 347     !         arg2 RBX MOV
 348     !         arg3 vm-reg MOV
 349     !         "overflow_fixnum_multiply" jit-call
 350     !     ]
 351     !     jit-conditional
 352     ! ] }
 353
 354     ! ## Misc
 355     ! { fpu-state [
 356     !     RSP 2 SUB
 357     !     RSP [] FNSTCW
 358     !     FNINIT
 359     !     AX RSP [] MOV
 360     !     RSP 2 ADD
 361     ! ] }
 362     ! { set-fpu-state [
 363     !     RSP 2 SUB
 364     !     RSP [] arg1 16-bit-version-of MOV
 365     !     RSP [] FLDCW
 366     !     RSP 2 ADD
 367     ! ] }
 368     ! { set-callstack [
 369     !     ! Load callstack object
 370     !     arg4 ds-reg [] MOV
 371     !     ds-reg bootstrap-cell SUB
 372     !     ! Get ctx->callstack_bottom
 373     !     jit-load-context
 374     !     arg1 ctx-reg context-callstack-bottom-offset [+] MOV
 375     !     ! Get top of callstack object -- 'src' for memcpy
 376     !     arg2 arg4 callstack-top-offset [+] LEA
 377     !     ! Get callstack length, in bytes --- 'len' for memcpy
 378     !     arg3 arg4 callstack-length-offset [+] MOV
 379     !     arg3 tag-bits get SHR
 380     !     ! Compute new stack pointer -- 'dst' for memcpy
 381     !     arg1 arg3 SUB
 382     !     ! Install new stack pointer
 383     !     RSP arg1 MOV
 384     !     ! Call memcpy; arguments are now in the correct registers
 385     !     ! Create register shadow area for Win64
 386     !     RSP 32 SUB
 387     !     "factor_memcpy" jit-call
 388     !     ! Tear down register shadow area
 389     !     RSP 32 ADD
 390     !     ! Return with new callstack
 391     !     0 RET
 392     ! ] }
 393 } define-sub-primitives
 394
 395
 396
 397 ! C to Factor entry point
 398 [
 399     ! ! Optimizing compiler's side of callback accesses
 400     ! ! arguments that are on the stack via the frame pointer.
 401     ! ! On x86-32 fastcall, and x86-64, some arguments are passed
 402     ! ! in registers, and so the only registers that are safe for
 403     ! ! use here are frame-reg, nv-reg and vm-reg.
 404     ! frame-reg PUSH
 405     ! frame-reg stack-reg MOV
 406
 407     ! ! Save all non-volatile registers
 408     ! nv-regs [ PUSH ] each
 409
 410     ! jit-save-tib
 411
 412     ! ! Load VM into vm-reg
 413     ! vm-reg 0 MOV 0 rc-absolute-cell rel-vm
 414
 415     ! ! Save old context
 416     ! nv-reg vm-reg vm-context-offset [+] MOV
 417     ! nv-reg PUSH
 418
 419     ! ! Switch over to the spare context
 420     ! nv-reg vm-reg vm-spare-context-offset [+] MOV
 421     ! vm-reg vm-context-offset [+] nv-reg MOV
 422
 423     ! ! Save C callstack pointer
 424     ! nv-reg context-callstack-save-offset [+] stack-reg MOV
 425
 426     ! ! Load Factor stack pointers
 427     ! stack-reg nv-reg context-callstack-bottom-offset [+] MOV
 428     ! nv-reg jit-update-tib
 429     ! jit-install-seh
 430
 431     ! rs-reg nv-reg context-retainstack-offset [+] MOV
 432     ! ds-reg nv-reg context-datastack-offset [+] MOV
 433
 434     ! ! Call into Factor code
 435     ! link-reg 0 MOV f rc-absolute-cell rel-word
 436     ! link-reg CALL
 437
 438     ! ! Load VM into vm-reg; only needed on x86-32, but doesn't
 439     ! ! hurt on x86-64
 440     ! vm-reg 0 MOV 0 rc-absolute-cell rel-vm
 441
 442     ! ! Load C callstack pointer
 443     ! nv-reg vm-reg vm-context-offset [+] MOV
 444     ! stack-reg nv-reg context-callstack-save-offset [+] MOV
 445
 446     ! ! Load old context
 447     ! nv-reg POP
 448     ! vm-reg vm-context-offset [+] nv-reg MOV
 449
 450     ! ! Restore non-volatile registers
 451     ! jit-restore-tib
 452
 453     ! nv-regs <reversed> [ POP ] each
 454
 455     ! frame-reg POP
 456
 457     ! ! Callbacks which return structs, or use stdcall/fastcall/thiscall,
 458     ! ! need a parameter here.
 459
 460     ! ! See the comment for M\ x86.32 stack-cleanup in cpu.x86.32
 461     ! 0xffff RET f rc-absolute-2 rel-untagged
 462 ] CALLBACK-STUB jit-define
 463
 464 [
 465     ! ! load literal
 466     ! temp0 0 MOV f rc-absolute-cell rel-literal
 467     ! ! increment datastack pointer
 468     ! ds-reg bootstrap-cell ADD
 469     ! ! store literal on datastack
 470     ! ds-reg [] temp0 MOV
 471 ] JIT-PUSH-LITERAL jit-define
 472
 473 [
 474     ! 0 CALL f rc-relative rel-word-pic
 475 ] JIT-WORD-CALL jit-define
 476
 477 ! The *-signal-handler subprimitives are special-cased in vm/quotations.cpp
 478 ! not to trigger generation of a stack frame, so they can
 479 ! peform their own prolog/epilog preserving registers.
 480 !
 481 ! It is important that the total is 192/64 and that it matches the
 482 ! constants in vm/cpu-x86.*.hpp
 483 : jit-signal-handler-prolog ( -- ) ;
 484     ! ! Return address already on stack -> 8/4 bytes.
 485
 486     ! ! Push all registers. 15 regs/120 bytes on 64bit, 7 regs/28 bytes
 487     ! ! on 32bit -> 128/32 bytes.
 488     ! signal-handler-save-regs [ PUSH ] each
 489
 490     ! ! Push flags -> 136/36 bytes
 491     ! PUSHF
 492
 493     ! ! Register parameter area 32 bytes, unused on platforms other than
 494     ! ! windows 64 bit, but including it doesn't hurt. Plus
 495     ! ! alignment. LEA used so we don't dirty flags -> 192/64 bytes.
 496     ! stack-reg stack-reg 7 bootstrap-cells neg [+] LEA
 497
 498     ! jit-load-vm ;
 499
 500 : jit-signal-handler-epilog ( -- ) ;
 501     ! stack-reg stack-reg 7 bootstrap-cells [+] LEA
 502     ! POPF
 503     ! signal-handler-save-regs reverse [ POP ] each ;
 504
 505 [
 506     ! ! load boolean
 507     ! temp0 ds-reg [] MOV
 508     ! ! pop boolean
 509     ! ds-reg bootstrap-cell SUB
 510     ! ! compare boolean with f
 511     ! temp0 \ f type-number CMP
 512     ! ! jump to true branch if not equal
 513     ! 0 JNE f rc-relative rel-word
 514     ! ! jump to false branch if equal
 515     ! 0 JMP f rc-relative rel-word
 516 ] JIT-IF jit-define
 517
 518
 519 [
 520     ! jit->r
 521     ! 0 CALL f rc-relative rel-word
 522     ! jit-r>
 523 ] JIT-DIP jit-define
 524
 525 [
 526     ! jit-2>r
 527     ! 0 CALL f rc-relative rel-word
 528     ! jit-2r>
 529 ] JIT-2DIP jit-define
 530
 531 [
 532     ! jit-3>r
 533     ! 0 CALL f rc-relative rel-word
 534     ! jit-3r>
 535 ] JIT-3DIP jit-define
 536
 537 ! [
 538 !     ! load from stack
 539 !     temp0 ds-reg [] MOV
 540 !     ! pop stack
 541 !     ds-reg bootstrap-cell SUB
 542 ! ]
 543 ! [ temp0 word-entry-point-offset [+] CALL ]
 544 ! [ temp0 word-entry-point-offset [+] JMP ]
 545 ! \ (execute) define-combinator-primitive
 546
 547 [
 548     ! temp0 ds-reg [] MOV
 549     ! ds-reg bootstrap-cell SUB
 550     ! temp0 word-entry-point-offset [+] JMP
 551 ] JIT-EXECUTE jit-define
 552
 553 [
 554     ! stack-reg stack-frame-size bootstrap-cell - SUB
 555 ] JIT-PROLOG jit-define
 556
 557 [
 558     ! stack-reg stack-frame-size bootstrap-cell - ADD
 559 ] JIT-EPILOG jit-define
 560
 561 [
 562     ! 0 RET
 563 ] JIT-RETURN jit-define
 564
 565 ! ! ! Polymorphic inline caches
 566
 567 ! The PIC stubs are not permitted to touch pic-tail-reg.
 568
 569 ! Load a value from a stack position
 570 [
 571     ! temp1 ds-reg 0x7f [+] MOV f rc-absolute-1 rel-untagged
 572 ] PIC-LOAD jit-define
 573
 574 [
 575     ! temp1/32 tag-mask get AND
 576 ] PIC-TAG jit-define
 577
 578 [
 579     ! temp0 temp1 MOV
 580     ! temp1/32 tag-mask get AND
 581     ! temp1/32 tuple type-number CMP
 582     ! [ JNE ]
 583     ! [ temp1 temp0 tuple-class-offset [+] MOV ]
 584     ! jit-conditional
 585 ] PIC-TUPLE jit-define
 586
 587 [
 588     ! temp1/32 0x7f CMP f rc-absolute-1 rel-untagged
 589 ] PIC-CHECK-TAG jit-define
 590
 591 [
 592     ! 0 JE f rc-relative rel-word
 593 ] PIC-HIT jit-define
 594
 595 ! ! ! Megamorphic caches
 596
 597 [
 598     ! ! class = ...
 599     ! temp0 temp1 MOV
 600     ! temp1/32 tag-mask get AND
 601     ! temp1/32 tag-bits get SHL
 602     ! temp1/32 tuple type-number tag-fixnum CMP
 603     ! [ JNE ]
 604     ! [ temp1 temp0 tuple-class-offset [+] MOV ]
 605     ! jit-conditional
 606     ! ! cache = ...
 607     ! temp0 0 MOV f rc-absolute-cell rel-literal
 608     ! ! key = hashcode(class)
 609     ! temp2 temp1 MOV
 610     ! bootstrap-cell 4 = [ temp2 1 SHR ] when
 611     ! ! key &= cache.length - 1
 612     ! temp2 mega-cache-size get 1 - bootstrap-cell * AND
 613     ! ! cache += array-start-offset
 614     ! temp0 array-start-offset ADD
 615     ! ! cache += key
 616     ! temp0 temp2 ADD
 617     ! ! if(get(cache) == class)
 618     ! temp0 [] temp1 CMP
 619     ! [ JNE ]
 620     ! [
 621     !     ! megamorphic_cache_hits++
 622     !     temp1 0 MOV rc-absolute-cell rel-megamorphic-cache-hits
 623     !     temp1 [] 1 ADD
 624     !     ! goto get(cache + bootstrap-cell)
 625     !     temp0 temp0 bootstrap-cell [+] MOV
 626     !     temp0 word-entry-point-offset [+] JMP
 627     !     ! fall-through on miss
 628     ! ] jit-conditional
 629 ] MEGA-LOOKUP jit-define
 630
 631 ! Comparisons
 632 : jit-compare ( insn -- ) drop ;
 633     ! ! load t
 634     ! temp3 0 MOV t rc-absolute-cell rel-literal
 635     ! ! load f
 636     ! temp1 \ f type-number MOV
 637     ! ! load first value
 638     ! temp0 ds-reg [] MOV
 639     ! ! adjust stack pointer
 640     ! ds-reg bootstrap-cell SUB
 641     ! ! compare with second value
 642     ! ds-reg [] temp0 CMP
 643     ! ! move t if true
 644     ! [ temp1 temp3 ] dip execute( dst src -- )
 645     ! ! store
 646     ! ds-reg [] temp1 MOV ;
 647
 648 ! Math
 649 : jit-math ( insn -- ) drop ;
 650     ! ! load second input
 651     ! temp0 ds-reg [] MOV
 652     ! ! pop stack
 653     ! ds-reg bootstrap-cell SUB
 654     ! ! compute result
 655     ! [ ds-reg [] temp0 ] dip execute( dst src -- ) ;
 656
 657 : jit-fixnum-/mod ( -- ) ;
 658     ! ! load second parameter
 659     ! temp1 ds-reg [] MOV
 660     ! ! load first parameter
 661     ! div-arg ds-reg bootstrap-cell neg [+] MOV
 662     ! ! make a copy
 663     ! mod-arg div-arg MOV
 664     ! ! sign-extend
 665     ! mod-arg bootstrap-cell-bits 1 - SAR
 666     ! ! divide
 667     ! temp1 IDIV ;
 668
 669 ! # Rest of arm64 subprimitives
 670 {
 671     ! ! ## Fixnums
 672
 673     ! ! ### Add
 674     ! { fixnum+fast [ \ ADD jit-math ] }
 675
 676     ! ! ### Bit stuff
 677     ! { fixnum-bitand [ \ AND jit-math ] }
 678     ! { fixnum-bitnot [
 679     !     ! complement
 680     !     ds-reg [] NOT
 681     !     ! clear tag bits
 682     !     ds-reg [] tag-mask get XOR
 683     ! ] }
 684     ! { fixnum-bitor [ \ OR jit-math ] }
 685     ! { fixnum-bitxor [ \ XOR jit-math ] }
 686     ! { fixnum-shift-fast [
 687     !     ! load shift count
 688     !     shift-arg ds-reg [] MOV
 689     !     ! untag shift count
 690     !     shift-arg tag-bits get SAR
 691     !     ! adjust stack pointer
 692     !     ds-reg bootstrap-cell SUB
 693     !     ! load value
 694     !     temp3 ds-reg [] MOV
 695     !     ! make a copy
 696     !     temp2 temp3 MOV
 697     !     ! compute positive shift value in temp2
 698     !     temp2 CL SHL
 699     !     shift-arg NEG
 700     !     ! compute negative shift value in temp3
 701     !     temp3 CL SAR
 702     !     temp3 tag-mask get bitnot AND
 703     !     shift-arg 0 CMP
 704     !     ! if shift count was negative, move temp0 to temp2
 705     !     temp2 temp3 CMOVGE
 706     !     ! push to stack
 707     !     ds-reg [] temp2 MOV
 708     ! ] }
 709
 710     ! ! ### Comparisons
 711     ! { both-fixnums? [
 712     !     temp0 ds-reg [] MOV
 713     !     ds-reg bootstrap-cell SUB
 714     !     temp0 ds-reg [] OR
 715     !     temp0 tag-mask get TEST
 716     !     temp0 \ f type-number MOV
 717     !     temp1 1 tag-fixnum MOV
 718     !     temp0 temp1 CMOVE
 719     !     ds-reg [] temp0 MOV
 720     ! ] }
 721     ! { eq? [ \ CMOVE jit-compare ] }
 722     ! { fixnum> [ \ CMOVG jit-compare ] }
 723     ! { fixnum>= [ \ CMOVGE jit-compare ] }
 724     ! { fixnum< [ \ CMOVL jit-compare ] }
 725     ! { fixnum<= [ \ CMOVLE jit-compare ] }
 726
 727     ! ! ### Div/mod
 728     ! { fixnum-mod [
 729     !     jit-fixnum-/mod
 730     !     ! adjust stack pointer
 731     !     ds-reg bootstrap-cell SUB
 732     !     ! push to stack
 733     !     ds-reg [] mod-arg MOV
 734     ! ] }
 735     ! { fixnum/i-fast [
 736     !     jit-fixnum-/mod
 737     !     ! adjust stack pointer
 738     !     ds-reg bootstrap-cell SUB
 739     !     ! tag it
 740     !     div-arg tag-bits get SHL
 741     !     ! push to stack
 742     !     ds-reg [] div-arg MOV
 743     ! ] }
 744     ! { fixnum/mod-fast [
 745     !     jit-fixnum-/mod
 746     !     ! tag it
 747     !     div-arg tag-bits get SHL
 748     !     ! push to stack
 749     !     ds-reg [] mod-arg MOV
 750     !     ds-reg bootstrap-cell neg [+] div-arg MOV
 751     ! ] }
 752
 753     ! ! ### Mul
 754     ! { fixnum*fast [
 755     !     ! load second input
 756     !     temp0 ds-reg [] MOV
 757     !     ! pop stack
 758     !     ds-reg bootstrap-cell SUB
 759     !     ! load first input
 760     !     temp1 ds-reg [] MOV
 761     !     ! untag second input
 762     !     temp0 tag-bits get SAR
 763     !     ! multiply
 764     !     temp0 temp1 IMUL2
 765     !     ! push result
 766     !     ds-reg [] temp0 MOV
 767     ! ] }
 768
 769     ! ! ### Sub
 770     ! { fixnum-fast [ \ SUB jit-math ] }
 771
 772     ! ! ## Locals
 773     ! { drop-locals [
 774     !     ! load local count
 775     !     temp0 ds-reg [] MOV
 776     !     ! adjust stack pointer
 777     !     ds-reg bootstrap-cell SUB
 778     !     ! turn local number into offset
 779     !     fixnum>slot@
 780     !     ! decrement retain stack pointer
 781     !     rs-reg temp0 SUB
 782     ! ] }
 783     ! { get-local [
 784     !     ! load local number
 785     !     temp0 ds-reg [] MOV
 786     !     ! turn local number into offset
 787     !     fixnum>slot@
 788     !     ! load local value
 789     !     temp0 rs-reg temp0 [+] MOV
 790     !     ! push to stack
 791     !     ds-reg [] temp0 MOV
 792     ! ] }
 793     ! { load-local [ jit->r ] }
 794
 795     ! ! ## Objects
 796     ! { slot [
 797     !     ! load slot number
 798     !     temp0 ds-reg [] MOV
 799     !     ! adjust stack pointer
 800     !     ds-reg bootstrap-cell SUB
 801     !     ! load object
 802     !     temp1 ds-reg [] MOV
 803     !     ! turn slot number into offset
 804     !     fixnum>slot@
 805     !     ! mask off tag
 806     !     temp1 tag-bits get SHR
 807     !     temp1 tag-bits get SHL
 808     !     ! load slot value
 809     !     temp0 temp1 temp0 [+] MOV
 810     !     ! push to stack
 811     !     ds-reg [] temp0 MOV
 812     ! ] }
 813     ! { string-nth-fast [
 814     !     ! load string index from stack
 815     !     temp0 ds-reg bootstrap-cell neg [+] MOV
 816     !     temp0 tag-bits get SHR
 817     !     ! load string from stack
 818     !     temp1 ds-reg [] MOV
 819     !     ! load character
 820     !     temp0 8-bit-version-of temp0 temp1 string-offset [++] MOV
 821     !     temp0 temp0 8-bit-version-of MOVZX
 822     !     temp0 tag-bits get SHL
 823     !     ! store character to stack
 824     !     ds-reg bootstrap-cell SUB
 825     !     ds-reg [] temp0 MOV
 826     ! ] }
 827     ! { tag [
 828     !     ! load from stack
 829     !     temp0 ds-reg [] MOV
 830     !     ! compute tag
 831     !     temp0/32 tag-mask get AND
 832     !     ! tag the tag
 833     !     temp0/32 tag-bits get SHL
 834     !     ! push to stack
 835     !     ds-reg [] temp0 MOV
 836     ! ] }
 837
 838     ! ! ## Shufflers
 839
 840     ! ! ### Drops
 841     ! { drop [ ds-reg bootstrap-cell SUB ] }
 842     ! { 2drop [ ds-reg 2 bootstrap-cells SUB ] }
 843     ! { 3drop [ ds-reg 3 bootstrap-cells SUB ] }
 844     ! { 4drop [ ds-reg 4 bootstrap-cells SUB ] }
 845
 846     ! ! ### Dups
 847     ! { dup [
 848     !     temp0 ds-reg [] MOV
 849     !     ds-reg bootstrap-cell ADD
 850     !     ds-reg [] temp0 MOV
 851     ! ] }
 852     ! { 2dup [
 853     !     temp0 ds-reg [] MOV
 854     !     temp1 ds-reg bootstrap-cell neg [+] MOV
 855     !     ds-reg 2 bootstrap-cells ADD
 856     !     ds-reg [] temp0 MOV
 857     !     ds-reg bootstrap-cell neg [+] temp1 MOV
 858     ! ] }
 859     ! { 3dup [
 860     !     temp0 ds-reg [] MOV
 861     !     temp1 ds-reg -1 bootstrap-cells [+] MOV
 862     !     temp3 ds-reg -2 bootstrap-cells [+] MOV
 863     !     ds-reg 3 bootstrap-cells ADD
 864     !     ds-reg [] temp0 MOV
 865     !     ds-reg -1 bootstrap-cells [+] temp1 MOV
 866     !     ds-reg -2 bootstrap-cells [+] temp3 MOV
 867     ! ] }
 868     ! { 4dup [
 869     !     temp0 ds-reg [] MOV
 870     !     temp1 ds-reg -1 bootstrap-cells [+] MOV
 871     !     temp2 ds-reg -2 bootstrap-cells [+] MOV
 872     !     temp3 ds-reg -3 bootstrap-cells [+] MOV
 873     !     ds-reg 4 bootstrap-cells ADD
 874     !     ds-reg [] temp0 MOV
 875     !     ds-reg -1 bootstrap-cells [+] temp1 MOV
 876     !     ds-reg -2 bootstrap-cells [+] temp2 MOV
 877     !     ds-reg -3 bootstrap-cells [+] temp3 MOV
 878     ! ] }
 879     ! { dupd [
 880     !     temp0 ds-reg [] MOV
 881     !     temp1 ds-reg -1 bootstrap-cells [+] MOV
 882     !     ds-reg [] temp1 MOV
 883     !     ds-reg bootstrap-cell ADD
 884     !     ds-reg [] temp0 MOV
 885     ! ] }
 886
 887     ! ! ### Misc shufflers
 888     ! { over [
 889     !     temp0 ds-reg -1 bootstrap-cells [+] MOV
 890     !     ds-reg bootstrap-cell ADD
 891     !     ds-reg [] temp0 MOV
 892     ! ] }
 893     ! { pick [
 894     !     temp0 ds-reg -2 bootstrap-cells [+] MOV
 895     !     ds-reg bootstrap-cell ADD
 896     !     ds-reg [] temp0 MOV
 897     ! ] }
 898
 899     ! ! ### Nips
 900     ! { nip [
 901     !     temp0 ds-reg [] MOV
 902     !     ds-reg bootstrap-cell SUB
 903     !     ds-reg [] temp0 MOV
 904     ! ] }
 905     ! { 2nip [
 906     !     temp0 ds-reg [] MOV
 907     !     ds-reg 2 bootstrap-cells SUB
 908     !     ds-reg [] temp0 MOV
 909     ! ] }
 910
 911     ! ! ### Swaps
 912     ! { -rot [
 913     !     temp0 ds-reg [] MOV
 914     !     temp1 ds-reg -1 bootstrap-cells [+] MOV
 915     !     temp3 ds-reg -2 bootstrap-cells [+] MOV
 916     !     ds-reg -2 bootstrap-cells [+] temp0 MOV
 917     !     ds-reg -1 bootstrap-cells [+] temp3 MOV
 918     !     ds-reg [] temp1 MOV
 919     ! ] }
 920     ! { rot [
 921     !     temp0 ds-reg [] MOV
 922     !     temp1 ds-reg -1 bootstrap-cells [+] MOV
 923     !     temp3 ds-reg -2 bootstrap-cells [+] MOV
 924     !     ds-reg -2 bootstrap-cells [+] temp1 MOV
 925     !     ds-reg -1 bootstrap-cells [+] temp0 MOV
 926     !     ds-reg [] temp3 MOV
 927     ! ] }
 928     ! { swap [
 929     !     temp0 ds-reg [] MOV
 930     !     temp1 ds-reg bootstrap-cell neg [+] MOV
 931     !     ds-reg bootstrap-cell neg [+] temp0 MOV
 932     !     ds-reg [] temp1 MOV
 933     ! ] }
 934     ! { swapd [
 935     !     temp0 ds-reg -1 bootstrap-cells [+] MOV
 936     !     temp1 ds-reg -2 bootstrap-cells [+] MOV
 937     !     ds-reg -2 bootstrap-cells [+] temp0 MOV
 938     !     ds-reg -1 bootstrap-cells [+] temp1 MOV
 939     ! ] }
 940
 941     ! ! ## Signal handling
 942     ! { leaf-signal-handler [
 943     !     jit-signal-handler-prolog
 944     !     jit-save-context
 945     !     temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
 946     !     temp0 CALL
 947     !     jit-signal-handler-epilog
 948     !     ! Pop the fake leaf frame along with our return address
 949     !     leaf-stack-frame-size bootstrap-cell - RET
 950     ! ] }
 951     ! { signal-handler [
 952     !     jit-signal-handler-prolog
 953     !     jit-save-context
 954     !     temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
 955     !     temp0 CALL
 956     !     jit-signal-handler-epilog
 957     !     0 RET
 958     ! ] }
 959 } define-sub-primitives
 960
 961 [ "bootstrap.arm.64" forget-vocab ] with-compilation-unit