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