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